無精・短気・傲慢

perlの事 いろいろ

mmt -- Master Maintenance Tool perl module.

目的

mmt.pmをmojoliciousで書き直す。

github

https://github.com/john-smith-7701/mmt に登録した。

memo

初めの一歩

$ mojo generate app Tool::mmt
$ tree toolmmt
toolmmt
├── lib
│     └── Tool
│            ├── mmt
│            │     └── Example.pm
│            └── mmt.pm
├── log
├── public
│     └── index.html
├── script
│     └── toolmmt
├── t
│     └── basic.t
└── templates
       ├── example
       │     └── welcome.html.ep
       └── layouts
              └── default.html.ep

10 directories, 7 files
$ svn import toolmmt svn+ssh://userId@localhost/usr/local/svn/repos/toolmmt -m "Initial Import."
$ svn co svn+ssh://userId@www21051ue.sakura.ne.jp/usr/local/svn/repos/toolmmt

2015/11/10現在

$ tree -f |perl -alne '@x=split /\s+/,`wc -l $F[-1] 2>/dev/null`;$l=sprintf("%5d %s",$x[0],$_);$l=~ s/ 0 /   /;$l=~ s{\..*/}{};print $l'
      .
      ├── lib
      │   └── Tool
      │       ├── mmt
   13 │       │   ├── Example.pm
  512 │       │   └── Mmt.pm
   25 │       ├── mmt.pm
      │       ├── Model
   46 │       │   └── Webdb.pm
    7 │       └── Model.pm
      ├── log
 3979 │   └── development.log
      ├── public
   11 │   └── index.html
      ├── script
   11 │   └── toolmmt
    4 ├── svn-commit.tmp
      ├── t
    9 │   └── basic.t
      └── templates
          ├── example
    7     │   └── welcome.html.ep
          ├── layouts
    5     │   └── default.html.ep
          └── mmt
   27         ├── datalist.html.ep
    5         ├── desc.html.ep
   29         └── mainform.html.ep
      
      12 directories, 15 files
$

2015/11/21

とりあえず素のメンテ作成。cssも JavaScript (12/9) も無し。

[2016/01/11]
     .
     ├── lib
     │   └── Tool
     │       ├── Model
     │       │   ├── Webdb
  29 │       │   │   └── constant.pm
 210 │       │   └── Webdb.pm
   7 │       ├── Model.pm
     │       ├── mmt
  35 │       │   ├── Commodity.pm
  13 │       │   ├── Example.pm
 759 │       │   ├── Mmt.pm
  19 │       │   └── Usertbl.pm
  28 │       └── mmt.pm
     ├── log
     ├── public
     │   ├── css
 121 │   │   └── default.css
  11 │   ├── index.html
     │   └── js
     ├── script
  11 │   └── toolmmt
   4 ├── svn-commit.tmp
     ├── t
   9 │   └── basic.t
     └── templates
         ├── example
   7     │   └── welcome.html.ep
         ├── layouts
  33     │   ├── default.html.ep
  32     │   └── defsubwin.html.ep
         └── mmt
  36         ├── datalist.html.ep
   9         ├── desc.html.ep
   4         ├── dumper.html.ep
  53         ├── mainform.html.ep
  32         └── subwin.html.ep
     
     15 directories, 21 files

構成

script/toolmmt # アプリケーションスクリプト

#!/usr/bin/env perl

use strict;
use warnings;

use FindBin;
BEGIN { unshift @INC, "$FindBin::Bin/../lib" }

# Start command line interface for application
require Mojolicious::Commands;
Mojolicious::Commands->start_app('Tool::mmt');

lib/Tool/mmt.pm # アプリケーションクラス（ルーター等）

package Tool::mmt;
use Mojo::Base 'Mojolicious';
use Tool::Model;

has 'model' => sub {Tool::Model->new};    # modelを追加
has 'controller' => "mmt";

# This method will run once at server start
sub startup {
  my $self = shift;

  # Documentation browser under "/perldoc"
  $self->plugin('PODRenderer');
  $self->plugin('TagHelpers');
  # Router
  my $r = $self->routes;
  # Normal route to controller
  $r->get('/')->to('example#welcome');
  $r->get('/mmt/:_table/desc')->to('mmt#desc');
  $r->get('/mmt/:_table')->to(controller => $self->controller,action =>'mainform');
  $r->post('/mmt/:_table')->to(controller => $self->controller,action => 'registry');
  $r->get('/mmtx/:controller')->to(controller => $self->controller,action =>'mainform');  # 特別なプレースフォルダ :controllerと:action　柔軟なルーティングの構築が可能になる
  $r->post('/mmtx/:controller')->to(controller => $self->controller,action => 'registry');
}

1;

lib/Tool/Model.pm

package Tool::Model;
use Mojo::Base 'Mojolicious';
use Tool::Model::Webdb;
has 'webdb' => sub { Tool::Model::Webdb->new };   # 自作モデルとか
1;

lib/Tool/Model/Webdb.pm #モデル (DB CONNECT とか…)

package Tool::Model::Webdb;
use Mojo::Base 'Mojolicious';
use DBI;
use utf8;
use Data::Dumper;
use Tool::Model::Webdb::constant;

has const => sub {
    my $s = shift;
    return Webdb::constant->new();  # constant dataを読み込む
};

has dbh => sub {
  my $self = shift;

  my $data_source = $self->const->{data_source};
  my $user        = $self->const->{user};
  my $password    = $self->const->{password};

  my $dbh = DBI->connect(
     $data_source,
     $user,
     $password,
     {RaiseError => 1,
      mysql_enable_utf8 =>1,
      mysql_auto_reconnect =>1,    # 再接続させる
     }
  );
  $dbh->do("set names UTF8");
  return $dbh;
};

sub desc_table{
  my $s = shift;
  my $m = shift || 'm';
  my $f;
  $s->{'m'}->{key} = [];
  $s->{'m'}->{item} = [];
  my $dbh = $s->dbh;
  my $sth = $dbh->prepare($s->desc_param($m));
  $sth->execute();
  my $flag = 0;
  while(my $ref = $sth->fetchrow_hashref()){
       $f = $ref->{Field};
       $s->{'m'}->{$f}->{Type} = $ref->{Type};
       $s->{'m'}->{$f}->{Null} = $ref->{Null};
       $s->{'m'}->{$f}->{Key} = $ref->{Key};
       $s->{'m'}->{$f}->{Default} = $ref->{Default};
       $s->{'m'}->{$f}->{Extra} = $ref->{Extra};
       $s->{'m'}->{$f}->{Size} = $s->size($ref->{Type});
       if($ref->{Key} eq 'PRI'){
           push @{$s->{'m'}->{key}},$f;
       }elsif($ref->{Type} =~ /timestamp/){
           $s->{'m'}->{timestamp} = $f;
       }else{  push @{$s->{'m'}->{item}},$f;
       }
       $flag = 1;
   }
   $sth->finish();
   return $s->{'m'};
}
sub size { . . . }
 .
 .
1;

lib/Tool/Model/Webdb/constant.pm # コンスタントデータ

package Webdb::constant;
use utf8;

sub new {
    my $class = shift;
    my $self = bless {},$class;
    $self->_initalize;
    return $self;
}
sub _initalize{
    my $s = shift;
    $s->{data_source} = "DBI:mysql:database=YourDB;host=localhost";
    $s->{user}        = "YourName";
    $s->{password}    = "YourPassword";

    $s->{explan} = {                            # DB項目の説明
        '担当者'    => {                        #   TABLE NAME
            'ID'    => 'admin:管理者,0～999',   #    FIELD NAME => COMMENT
        },
        '商品'      => {
            '商品区分' => '0:課税,1:非課税,2:軽減課税',
        },
    };
}

1;

lib/Tool/mmt/Mmt.pm # controller

package Tool::mmt::Mmt;
use Mojo::Base 'Mojolicious::Controller';
use Mojo::Log;
use utf8;
use Encode;
use Text::CSV::Encoded;

has 'mmtForm' => 'mmt/mainform';
has 'mmtDataList' => 'mmt/datalist';

# This action will render a template
sub mainform {
    my $self = shift;

    $self->{'m'} = $self->app->model->webdb->desc_table($self->param('_table'));      # model 呼び出し
    $self->{'m'}->{'table'} = $self->param('_table');
    $self->set_input_names();
    $self->action_set();

    $self->my_render($self->mmtForm);
}
sub my_render{
    my $s = shift;
    my $render = shift;
    $s->stash->{_title} = join('',$s->param('_table'));
    $s->render($render);
}
sub registry{
   my $self = shift;

   $self->action_set();
   my $log = Mojo::Log->new();
   $log->debug( "IN registry" );

   for my $action  (@{$self->{'_action'}}) {
       if($action->{'name'} eq $self->param('_action')){
           return $action->{action}();
       }
   }
   $self->stash->{'_dumper'} = $self->dumper ($self->param()) .
       $self->param('_action');
   $self->render('mmt/dumper');
}
 .
 .
 .

templates/mmt/mainform.html.ep # データメンテナンス画面

% layout 'default';
% title "mmt - $_title " ;
<h1><%= $_title %></h1>

%= form_for url_for('_table'=> param('_table')) => (method => 'POST') => begin
<%= hidden_field timestamp => param('timestamp') %>
<%= hidden_field _table => param('_table') %>
<table>
% for my $item (@{$self->{'m'}->{'key'}}){
 <tr>
  <th><div id="<%= 'l_' . $self->{'n'}->{$item} %>"> <%= $self->Label($item) %></div></th>
  <td><%== $self->input_field($item) %>
      <%== $self->get_explan(param('_table'),$item) %></td>
  <td><div id="<%= 'd_' . $self->{'n'}->{$item} %>">
 </tr>
% }
</table>
%= submit_button $self->{'_action'}[0]->{'name'} ,id => '_action',name => '_action'
<%== $self->serch_input_field() %>
%= submit_button $self->{'_action'}[4]->{'name'} ,id => '_action',name => '_action'
%= submit_button $self->{'_action'}[6]->{'name'} ,id => '_action',name => '_action'
<br>
INFO:<%= $self->{errstr} %>
<hr>
<table>
% my $i = 0;
% for my $item (@{$self->{'m'}->{'item'}}){
 <tr>
  <th><div id="<%= 'l_' . $self->{'n'}->{$item} %>"> <%= $self->Label($item) %></div></th>
  <td><%== $self->input_field($item) %>
      <%== $self->get_explan(param('_table'),$item) %></td>
  <td><div id="<%= 'd_' . $self->{'n'}->{$item} %>"></div></td>
 </tr>
% }
</table>

% for my $item (@{$self->{'_action'}}[1..3]){
%= submit_button $item->{'name'} ,id => '_action',name => '_action'
%  }
% end
<hr>
<form method="post" action="<%= url_for('_table'=> param('_table')) %>"
            enctype ="multipart/form-data">

        <input type="file" name="upload_file" />
        <%= hidden_field _table => param('_table') %>
        <input type="submit" value="Upload" name="_action" />
</form>

templates/mmt/datalist.html.ep # 一覧表示画面

% layout 'default';
% title "mmt - $_title";
<h1><%= $_title %></h1>
<table><tr><th></th>
% for my $item (@{$self->{'m'}->{'key'}},@{$self->{'m'}->{'item'}}){
  <th><div id="<%= $item %>"> <%= $self->Label($item) %></div></th>
% }
</tr>
% my $count = 0;
% while (my $ref = $self->{'sth'}->fetchrow_hashref()){
%   $count++;
%   last if $count > 2000;
<tr>
%= form_for url_for('_table'=> param('_table')) => (method => 'POST') => begin
<%= hidden_field _table => param('_table') %>
    <td>
    %= submit_button $self->{'_action'}[0]->{'name'} ,id => '_action',name => '_action'
    </td>
%   for my $name (@{$self->{'m'}->{key}}){
        <td><%= $ref->{Encode::encode("utf8",$name)} %>
        <%= hidden_field $self->{'n'}->{$name} => $ref->{Encode::encode("utf8",$name)} %>
        </td>
%   }
%   for my $name (@{$self->{'m'}->{item}}){
        <td><%= $ref->{Encode::encode("utf8",$name)} %></td>
%   }
% end
</tr>
% }
</table>
%=   "* No Data *" if ($count == 0);
%=   "* Max over * " if ($count > 2000);

templates/mmt/Commodity.pm # Mmtを継承したアプリケーション

package Tool::mmt::Commodity;
use Mojo::Base 'Tool::mmt::Mmt';

has 'mmtDataList' => 'mmt/datalist';

sub init_set {
    my $s = shift;
    $s->mmtForm('mmt/mainform');
    $s->param('_table','商品');
}
sub look_up_set{
    my $s = shift;
    $s->{'m'}->{LOOK_UP}->{ref $s}->{$s->{'n'}->{'大分類'}} = 
        ["select 略称 from 分類名称 where 中分類 = '' and 小分類 = '' and 大分類 = ? ", 
            [$s->{'n'}->{'大分類'}] ];
    $s->{'m'}->{SUBWIN}->{ref $s}->{$s->{'n'}->{'大分類'}} = 
        ["select 大分類,略称 from 分類名称 where 中分類 = '' and 小分類 = ''", 
             []];

    $s->{'m'}->{LOOK_UP}->{ref $s}->{$s->{'n'}->{'中分類'}} = 
        ["select 略称 from 分類名称 where 大分類 = ? and 中分類 = ? and 小分類 = '' ", 
            [$s->{'n'}->{'大分類'},$s->{'n'}->{'中分類'}] ];
    $s->{'m'}->{SUBWIN}->{ref $s}->{$s->{'n'}->{'中分類'}} = 
        ["select 中分類,略称 from 分類名称 where 大分類 = ? and 中分類 <> '' and 小分類 = ''", 
            [$s->{'n'}->{'大分類'}] ];

    $s->{'m'}->{LOOK_UP}->{ref $s}->{$s->{'n'}->{'小分類'}} = 
        ["select 略称 from 分類名称 where 大分類 = ? and 中分類 = ? and 小分類 = ? ", 
            [$s->{'n'}->{'大分類'},$s->{'n'}->{'中分類'},$s->{'n'}->{'小分類'}] ];
    $s->{'m'}->{SUBWIN}->{ref $s}->{$s->{'n'}->{'小分類'}} = 
        ["select 小分類,略称 from 分類名称 where 大分類 = ? and 中分類 = ? and 小分類 <> ''", 
            [$s->{'n'}->{'大分類'},$s->{'n'}->{'中分類'}] ];
}

1;

TODO

  • validation
  • 検索SUB画面 (1/7)
  • 綺麗な画面
  • ENTERで項目移動 (12/9)
  • セッション管理
  • login処理
  • メニュー作成
  • レポートライターツール

ENTERで項目移動 (12/9)

[toolmmt/templates/layouts/toolmmt/templates/layouts]
 <!DOCTYPE html>
 <html>
   <head><title><%= title %></title>
    <script src="http://ajax.googleapis.com/ajax/libs/jquery/1.7/jquery.min.js"></script>
      <script type="text/javascript">  <!-- [jQuery] Enterキーでフォーカスを移動するには http://blog.makotoishida.com/2013/02/javascript-enter.html -->
             $(function(){
               var elements = "input[type=text]";
               $(elements).keypress(function(e) {
                 var c = e.which ? e.which : e.keyCode;
                 if (c == 13) { 
                   var index = $(elements).index(this);
                   var criteria = e.shiftKey ? ":lt(" + index + "):last" : ":gt(" + index + "):first";
                   $(elements + criteria).focus();
                   e.preventDefault();
                 }
               });
             });
      </script>
   </head>
   <body><%= content %></body>
 </html>

ajaxにてテーブル参照とサブウインドを開く

 sub make_ajax{
     my $s = shift;
     my $p = '';
     my $onload = '';
     #
     # マスタ参照ajax(LOOK_UPをサーチ)
     #
     for (keys %{$s->{'m'}->{LOOK_UP}->{ref $s}}){
         next unless ($_ =~ /^(\D)+(\d)+$/);
         $p .= $s->new_updater($_);
         $onload .= "\$('#$_').change();\n";
     }
     #
     # マスタ参照ウインド(WUBWINをサーチ)
     #
     for (keys %{$s->{'m'}->{SUBWIN}->{ref $s}}){
         next unless ($_ =~ /^(\D)+(\d)+$/);
         $p .= $s->new_subwin($_);
     }
     return $p . $onload;
 }
 #
 # マスタ参照(http://www21051ue.sakura.ne.jp:3003/mmtx/commodity?_action=get_name&n=item5&p=001&p=002)
 #
 sub get_name{
     my $s = shift;
     my @names = qw/未登録/;
     #eval {
         @names = $s->app->model->webdb->dbh->selectrow_array(
                     $s->{'m'}->{LOOK_UP}->{ref $s}->{$s->param('n')}->[0],undef,$s->param('p'));
     #};
     if ($@){
         $s->render(json=>$@);
     } else{
         my $json = {rec=>@names};
         $s->render(json=>$json);        # JSONを描画する
     }
 }
 sub subwin{
     my $s = shift;
     my $subwin = $s->{'m'}->{SUBWIN}->{ref $s}->{$s->param('n')};
     my $sql = $subwin->[0];
     my $render = $subwin->[2] || 'mmt/subwin';
     my $param = $s->param('p');
     my $dbh = $s->app->model->webdb->dbh;
     $s->{'sth'} = $dbh->prepare($sql);
     $s->{'sth'}->execute($s->param('p'));
     $s->stash->{_title} = '検索';
     $s->stash->{_sql} = $sql;
     $s->stash->{_controller} = ref $s;
     $s->render($render);
 }
 sub new_updater{
     my $s = shift;
     my $n = shift;
     my $p = '"';
     $p .= join '',map{qq{ + "&p=" + \$('#$_').val()}} @{$s->{'m'}->{'LOOK_UP'}->{ref $s}->{$n}->[1]};
     return <<End_Script;
 jQuery('#$n').change( function (){                  // 内容が変化した時に実行
     jQuery.ajax({                                   // http通信を行う
      type: 'GET',                                   // 通信種類を指定(GET,POST,PUT,DELETE)
      dataType: 'json',                              // サーバーから返されるデータタイプ
      data: "_action=get_name&n=$n$p ,               // サーバーに送信する値
      success:function(data,textStatus,jqXHR){       // ajax通信が成功した時のajax event
       jQuery('#d_$n').html(data.rec);               // 返値を描画
      return false;
      }
     });
 });
 End_Script
 }
 sub new_subwin{
     my $s = shift;
     my $n = shift;
     my $p = '"';
     $p .= join '',map{qq{ + "&p=" +  \$('#$_').val()}} @{$s->{'m'}->{'SUBWIN'}->{ref $s}->{$n}->[1]};
     my $win_para = "width=600,height=500,resizable=yes,scrollbars=yes";
     return <<End_Script;
 jQuery(document).ready(function(){                  
     jQuery('#l_$n').html(                           // LABELをボタンに変更する
         "<input type=button value=@{[$s->Label($s->get_input_name($n))]}>");
 });
 
 jQuery('#l_$n').click( function (){                 // SUB WINDOWを開く
     window.open("@{[$s->url_for->query(            
                         _action=>'subwin'
                         ,n=>$n
                         )
                   ]}$p,'_blank','$win_para');
     return false;
 });
 End_Script
 }
 
 1;

SUB WINDOW

[layouts/defsubwin.html.ep]
<!DOCTYPE html>
<html>
  <head><title><%= title %></title>
   <script src="http://ajax.googleapis.com/ajax/libs/jquery/1.7/jquery.min.js"></script>
     <script type="text/javascript">  <!-- [jQuery] Enterキーでフォーカスを移動するには http://blog.makotoishida.com/2013/02/javascript-enter.html -->
            $(function(){
              var elements = "input[type=text]";
              $(elements).keypress(function(e) {
                var c = e.which ? e.which : e.keyCode;
                if (c == 13) { 
                  var index = $(elements).index(this);
                  var criteria = e.shiftKey ? ":lt(" + index + "):last" : ":gt(" + index + "):first";
                  $(elements + criteria).focus();
                  e.preventDefault();
                }
              });
            });
            function setVal(terget,val){
                window.opener.$("#"+terget).val(val);           // 選択値を親画面にセットする
                window.opener.$("#"+terget).change();           // changeイベントを発生する
                window.opener.$("#"+terget).focus();            // フォーカスを移動する
                window.close();                                 // 自ウィンドを閉じる
            }
     </script>
     <%= stylesheet '/css/default.css' %>
  </head>
  <body>
    <div class="subwin">
      <%= content %>
    </div>
  </body>
</html>

[mmt/subwin.html.ep]
% layout 'defsubwin';
% title "mmt - $_title";
<h1><%= $_title %></h1>
<%= $_sql %><br />
[<%= $_controller %>][<%= param('n') %>][<%= join '|',param('p') %>]
<table border=1><thead><tr>
% for my $item (@{$self->{'sth'}->{'NAME'}}){
  <th><div id="<%= $item %>"> <%= Encode::decode('UTF-8',$item) %></div></th>
% }
</tr>
</thead>
<tbody>
% my $count = 0;
% while (my $ref = $self->{'sth'}->fetchrow_arrayref()){
%   $count++;
%   last if $count > 2000;
<tr>
%   my $i = 0;
%   for my $item (@{$ref}){
%       $i++;
        <td>
%       if($i == 1){
            <a href="" onclick="setVal('<%= param('n') %>','<%= $item %>');">
%       }
        <%= $item %></td>
%   }
</tr>
% }
</tbody>
</table>
%=   "* No Data *" if ($count == 0);
%=   "* Max over * " if ($count > 2000);

gitbash

gitbash

これだけあればwindowsを使うのが楽しくなる。

ここhttps://git-for-windows.github.io/からダウンロード

gitは使わないが（まだ）これをインストールすればwindowsでbash,vim,perlが使える。windowsで*nixLIKEのオペレーションが…

日本語の設定 .profileを編集　(vim .profile)

cat .profile
export LANG=ja_JP.UTF8
export PS1="$ "

これで十分

gitbash

gitbash

編集

これだけあればwindowsを使うのが楽しくなる。

ここhttps://git-for-windows.github.io/からダウンロード

gitは使わないが（まだ）これをインストールすればwindowsでbash,vim,perlが使える。windowsで*nixLIKEのオペレーションが…

日本語の設定 .profileを編集　(vim .profile)

cat .profile
export LANG=ja_JP.UTF8
export PS1="$ "

これで十分

 

YAPC Asia TOKYO 2015

夏だ！祭だ！YAPC::Asia

What is YAPC?

世界最大のYAPCが最後の大花火をぶちあげに今年ももどってきました！YAPCはYet Another Perl Conferenceの略で、Perlに関するカンファレンス・・・いや、お祭りです！Perlだけに限らず、様々な分野のギーク達が集まり技術の話と楽しさに満ちた三日間のお祭りが開かれます。Perlに関連する事に興味がなくとも心配する必要は全くありません、YAPC::Asia Tokyo 2015は技術者であれば誰でも楽しめるカンファレンスです。

今年も様々なゲストを集めて熱いトークが交わされます。世界中のギーク達がどんな事を今を考えているのか行っているのか、是非皆様も体験しに来て下さい！

との事です。

銅鑼パーソン

day0

初参戦です。

PHP帝国の逆襲！（を願うPHPerが話す最近のPHPについてのクイックツアー PHP7対応版） (鶉)

いよいよYAPC Asia TOKYO 2015の開幕です。流石に@uzullaさん軽妙トークでした。ハチピーシール頂きました。

Perlワンライナー入門 (Akira Sakamoto)

ワンライナー好きです。便利です。perl6でも使いたい。

day1

メリークリスマス！(Larry Wall)

[フィボナッチ数列]yapcasia 2015 day1でラリーがデモしてた。（ちょっと違うけど）perl6すげー

$ perl6 -e 'my @Fib := 0, 1, * + * ... *;say @Fib[0..30]'
0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 17711 28657 46368 75025 121393 196418 317811 514229 832040

TBD(Yukihiro "Matz" Matsumoto)

「絶対に型を書きたくないでござる」rubyは使った亊ないが同感です。

Perlで学ぼう！文系プログラマのための、知識ゼロからのデータ構造と計算量(Shinpei Maruyama)

我らがNiigata.pm代表。出遅れたため立ち見でした。流石、解りやすかったです。ShipeiさんがNiigata.pmを立ち上げてくれたおかげで今回のYAPCに参加する事が出来ました。

PietでLISP処理系を書くのは難しい (Hideaki Nagamine)

「perlでLISP…」と思っていたら「PietでLISP…」でした。始めて見る言語（画像？）でした。

Perl6 on JVM: It works??(Tokuhiro Matsuno)

まだまだ、これからのperl6に期待します。

Lightning Talks Day 1(スポンサー「株式会社ネコトーストラボ」)

  • スポンサー「株式会社ネコトーストラボ」

懇親会

ラリーに合うことが出来た。2台目のアコードに乗っているそうです。一緒に写真に写って貰いました。感激です。家宝です。

day 2

Perl 5.22 and You (Ricardo Signes)

まだまだ、perl(5)は進化します。どんどん使おう！！

Parallelism, Concurrency, and Asynchrony in Perl 6(Jonathan Worthington)

まだまだ開発中！！wheneeverとは何者だ…

for loopは同期的処理。 非同期のループは？ perl6ではwhenever

wheneever IO::NOptification.watch-path($test-dir) {
  maybe...
}

クロージング

スタッフの皆さんご苦労様でした。スピーカーの皆さん有難う御座いました。参加した皆さん…。楽しい3日間でした。（タンブラー格好良いね）

夏祭り終わり…シュルシュルシュル～ドッカーン！！！

 

飛び出せPerl6

飛び出せperl6

アスキーでステレオグラム。ワンライナーで『パール6』を浮き出させる。いまいち飛び出ないか…。もっとガンガレ…

$ perl6 -e 'sub MAIN($x,$y){ for 1..10 -> $i { for 1..7 -> $j { print ($i==9 and $j==6)??"$y "!!"$x ";}; print "\n";}}' ...perl... ..perl6...
...perl... ...perl... ...perl... ...perl... ...perl... ...perl... ...perl... 
...perl... ...perl... ...perl... ...perl... ...perl... ...perl... ...perl... 
...perl... ...perl... ...perl... ...perl... ...perl... ...perl... ...perl... 
...perl... ...perl... ...perl... ...perl... ...perl... ...perl... ...perl... 
...perl... ...perl... ...perl... ...perl... ...perl... ...perl... ...perl... 
...perl... ...perl... ...perl... ...perl... ...perl... ...perl... ...perl... 
...perl... ...perl... ...perl... ...perl... ...perl... ...perl... ...perl... 
...perl... ...perl... ...perl... ...perl... ...perl... ...perl... ...perl... 
...perl... ...perl... ...perl... ...perl... ...perl... ..perl6... ...perl... 
...perl... ...perl... ...perl... ...perl... ...perl... ...perl... ...perl... 
$

多項式の因数分解（factorization）

高校の数学の本を元にアルゴリズム(algorithm)の備忘録として

使い方

$ perl factor.pl '8x^3+12x^2-2x-3'
(2x-1)(2x+1)(2x+3)
$  perl factor.pl ' x^4+x^2+1 '
(x^2+x+1)(x^2-x+1)
$

【計算】

[factor.pl]

$str = shift || ' 8x^3+12x^2-2x-3 ';        #<----- 

$str =~ s/\s//g;
print factor($str)."\n";
sub factor{
    my @a = arrange(shift);     # 式の整理 次数でまとめる
    if((my $i = arrayGcd(@a)) > 1){
        for(@a){ $_ /= $i;}
        return ed2(ed($i).factor(array2expr(@a)));
    }
    return factor_div(@a) if($#a > 2);  #３次以上の時は因数定理？除算の定理？で求める
    return ed2("x(".ed($a[2])."x".ed($a[1]).")") unless($a[0]);
    my @a0 = measure($a[0],1);  # 約数を求める a0 = (b1,b2)...
    my @a2 = measure($a[2],0);  #   "          a2 = (c1,c2)...
    for (@a0){                  # (a0,a1,a2)=(b1,c1)(b2,c2)
        my ($b1,$b2) = split ",";   # a1=b1*c2+b2*c1となるb1,b2,c1,c2を求める
        for(@a2){
            my ($c1,$c2) = split ",";
            return ed2("(".ed($c1)."x".ed($b1).")(".ed($c2)."x".ed($b2).")")
                    if($a[1] == $b1*$c2+$b2*$c1);
            return ed2("(".ed($c2)."x".ed($b1).")(".ed($c1)."x".ed($b2).")")
                    if($a[1] == $b1*$c1+$b2*$c2);
        }
    }
    return "(".array2expr(@a).")";  # 数値を式に変換 -> a2 x^2 + a1 x + a0 
}
sub factor_div{             # 因数定理？　除算の定理？
    my @a = @_;
    my ($tmp,$tmp1,$k);
    for my $z (1..abs($a[$#a])){
        for(my $i=1;$i<=abs($a[0]);$i++){
            $tmp = $tmp1 = 0;
            $k = 0 - $i;
            for(my $j=0;$j<=$#a;$j++){
                my $z2 = ($j) ? $z : 1;
                $tmp += $a[$j]*($i**$j)/($z2**$j);
                $tmp1 += $a[$j]*($k**$j)/($z2**$j);
            }                                                      # 誤差調整の為、sprintfを追加
            return ed2("(".ed($z)."x".ed(0-$i).")".factor(array2expr(div($z,0-$i,@a)))) 
                                                                   unless(sprintf("%f",$tmp)+0);
            return ed2("(".ed($z)."x".ed(0-$k).")".factor(array2expr(div($z,0-$k,@a)))) 
                                                                   unless(sprintf("%f",$tmp1)+0);
        }
    }
    if($a[0]==0){
        shift @a;
        return ed2("x".factor(array2expr(@a)));
    }
    if(@a==5 and $a[1]==0 and $a[2]==0 and $a[3]==0 and
           $a[4] >= 0 and $a[4] == (int(sqrt($a[4])))**2){
        my @b = (@a[0],0,1);
        my $n=sqrt(@a[4]);
        my $ans = factor(array2expr(@b));
        if($n == 1){$n="";};
        if($ans =~ s/x([+-])/${n}x\^2$1/g){
            return $ans;
        }else{
            return "(".array2expr(@a).")";
        }
    }elsif(@a==5 and $a[1]==0 and $a[3]==0){
        my @b = @a[0,2,4];
        my $ans = factor(array2expr(@b));
        if($ans !~ /(\(.+\)){2,}/){            # X^2をXと置いてa^2-b^2=(a+b)(a-b)の公式にて ※1
            if($b[0] >= 0 and $b[2] == 1 and $b[1]+1 == sqrt($b[0])*2){ 
                return "(" . array2expr(sqrt($b[0]),1,1) . ")(" . array2expr(sqrt($b[0]),-1,1) . ")" ;
            }
            return "(" . array2expr(@a) . ")";
        }
        $ans =~ s/x/x^2/g;
        return $ans;
    }else{
        return "(".array2expr(@a).")";
    }
}
sub div{
    my ($x,$z,@a) = @_;
    my @b;
    for (my $i = $#a;$i>0;$i--){
            $b[$i-1]=$a[$i]/$x;
            $a[$i-1]-= $z*$b[$i-1];
    }
    return @b;
}
sub arrange{                # 式の整理
    my $str = shift;
    my @a = (0,0,0);
    my ($b,$c);
    while($str =~ s/([+-]*[\d\.]*)x\^([\d\.]*)//){
        $b=$2;
        $c=$1;
        $a[$b] += ($c =~ /^[+-]*$/) ? "$c" . "1" : $c;
    }
    while($str =~ s/([+-]*[\d\.]*)x//){
        $c = $1;
        $a[1] += ($c =~ /^[+-]*$/) ? "$c" . "1" : $c;
    }
    while($str =~ s/([+-]*[\d\.]{1,})//){
        $a[0] += $1;
    }
    return @a;
}
sub measure{               # 約数を求める
    my ($a,$flag) = @_;
    my $n = abs($a);
    my @ans = ();
    for (my $j = int(sqrt($n)); $j > 0;$j--){
        unless ($n % $j){
            if($a<0){
                push(@ans,join(",",$j,$n/$j*(-1)));
                push(@ans,join(",",$j*(-1),$n/$j));
            }else{
                push(@ans,join(",",$j,$n/$j));
                push(@ans,join(",",$j*(-1),$n/$j*(-1))) if($flag);
            }
        }
    }
    return @ans;
}
sub array2expr{            # 数値を式に変換
    my @a = @_;
    my $new = "";
    for (my $i = $#a ; $i>=0;$i--){
        next if($a[$i] ==0);
        $new .= ed($a[$i]);
        if($i == 1){
            $new .= "x";
        }elsif($i > 1){
            $new .= "x^".$i;
        }
    }
    return ed2($new);
}
sub arrayGcd{
#    my @a = @_;
    my $ans = 0;
    for(@_){ $ans = gcd($ans,$_);}
    return abs($ans);
}
sub gcd{
    my ($x,$y) = @_;
    return $y ? gcd($y,$x % $y) : $x ;
}

sub ed{
    my $n = shift;
    return ($n >= 0) ? "+" . $n : $n;
}
sub ed2{
    my $str = shift;
    $str =~ s/([+-])1(x)/$1$2/g;
    $str =~ s/^\+//;
    $str =~ s/\(\+/\(/g;
    my $sub = 1;
    if ($str =~ s/xx(\^(\d+))/XX/){
        $sub = $2;
    }
    while($str =~ s/xx/X/i){$sub++;}
    $str =~ s/X/x^$sub/ ;
    return $str;
}

※1 複２次式の因数分解 / 数学I by ふぇるまー ｜マナペディア｜を参照