無精・短気・傲慢

perlの事 いろいろ

mojolicious memo

perl WAF

Mojolicious(モジョリシャス)はperl製のWebアプリケーションフレームワークです。2つのウェブサーバが同梱されていてmojoliciousだけセットアップすれはwebを開発、公開できます。1つはmorbo (モーボ)で開発用のサーバーです。起動しっぱなしでも起動後に更新されたモジュールがロードされます。もう1つのhypnotoad (ハイプノトード)はプリフォークサーバーでホットデプロイメントを行うことができます。

  • 起動
$ morbo script/<myApp>
→ Server available at http://127.0.0.1:3000
- or -
$ hypnotoad script/<myApp>

データベースにSQLiteを使えばサーバーを立てずにお手軽にWebを公開出来ます。

mojoliciousでJSONをPOSTで送信と受信

デモ画面を作ってみた。

[toolmmt/templates/json/json.html.ep]

% layout 'default';
% title 'mojplicious JSON DEMO';
<h1>mojolicious JSON Demo</h1>
<hr><h4>JSON</h4>
<ul>
  <li><a href="http://www21051ue.sakura.ne.jp:3003/api/json/json_test01">json_test001</a></li>
</ul>
<h4>JSON POST</h4>
<script type="text/javascript">
    $(function(){
        $("#response").html("Response Values");
        $("#button").click( function(){
            var url = $("#url_post").val();
                var JSONdata = {
                    value1: $("#value1").val(),
                    value2: $("#value2").val()      
                };
            // alert(JSON.stringify(JSONdata));
            $.ajax({
                type : 'post',
                url : url,
                data : JSON.stringify(JSONdata),
                contentType: 'application/JSON',
                dataType : 'JSON',
                scriptCharset: 'utf-8',
                success : function(data) {
                    // Success
                    // alert("success");
                    // alert(JSON.stringify(data));
                    $("#response").html(JSON.stringify(data));
                },
                error : function(data) {
                    // Error
                    alert("error");
                    alert(JSON.stringify(data));
                    $("#response").html(JSON.stringify(data));
                }
            });
        })
    })
</script>

    <h2>HTMLファイルからPOSTでJSONデータを送信する</h2>
    <p>URL: <input type="text" id="url_post" name="url" size="100" value="<%== url_for %>"></p>
    <p>value1: <input type="text" id="value1" size="30" value="値1"></p>
    <p>value2: <input type="text" id="value2" size="30" value="値2"></p>
    <p><button id="button" type="button">submit</button></p>
    <textarea id="response" cols=120 rows=10 disabled></textarea>


[toolmmt/lib/Tool/mmt/Controller/Json.pm]

package Tool::mmt::Controller::Json;
use Mojo::Base 'Tool::mmt::Controller::Mmt';

sub json_post{
    my $s = shift;
    use Mojo::UserAgent;
    my $ua = Mojo::UserAgent->new;
    my $data = $ua->post('http://localhost:3001/api/example/json' =>  {Accept=> '*/*'} => json => {a => 'b'});
    $s->render(json => $data->res->json);
}
sub json_test01{
    my $s = shift;
    $s->render(json => {head => 'Json Test Data',array=>[1,2,3,4],lang=>['perl','ruby','php'],
        日本語=>['漢字','ひらがな','カタカナ']});
}

sub json{
    my $s = shift;
    $s->render(json => $s->req->json);
}

1;

コントローラーのディレクトリが変わった

どのバージョンで変わったか解らないがコントローラーのディレクトリが変わっていた。以前はlib/<myApp>の下がコントローラだったがlib/<myApp>/Controller下になっていた。両方のバージョンで動かす為にはstartupにてnamespacesを設定する。

 $r->namespaces(['Tool::mmt::Controller']);

オプショナルなプレースホルダ

ふたつのオプショナルなプレースホルダーが、スラッシュによって分割されている場合だけ、 スラッシュはオプショナルなものになります。

 # /           -> {controller => 'foo',   action => 'bar'}
 # /users      -> {controller => 'users', action => 'bar'}
 # /users/list -> {controller => 'users', action => 'list'}
 $r->get('/:controller/:action')->to('foo#bar');

controllerやactionなどの特別なスタッシュの値もまたプレースホルダーとなりえます。これによってきわめて柔軟なルーティングの構築が可能になります。 これは開発の間は特にとても便利ですが、 すべてのコントローラーメソッドがルーティングになる可能性 があるので、注意深く利用すべきです。 アンダースコアで始まるこれらのメソッドと同じように、すべての大文字のメソッドは 自動的にルーターから隠されます。 追加的に隠すためにMojolicious::Routesのhideを使うこともできます。

/:controller/:actionでコントローラとアクション(メソッド)を柔軟に設定できます。

mojoliciousで作ったアプリ

 

中置記法から後置記法(逆ポーランド記法)への変換と計算

  Calculation and conversion to postfix notation (Reverse Polish Notation) from infix notation

perlでは入力内容をevalすれば良いだけだけどアルゴリズム(algorithm)の備忘録として書いてみた。

  使い方

$ perl calc.pl "((1+5)*(-2+-3) * -1)**2 % 8"
4$
$ perl calc.pl "6/2(1+2)"
1$

計算

  [calc.pl]

use strict;
my $op = { '-' => [sub {$_[1] - $_[0]},1],
           '+' => [sub {$_[1] + $_[0]},1],
           '*' => [sub {$_[1] * $_[0]},2],
           '/' => [sub {$_[1] / $_[0]},2],
           '%' => [sub {$_[1] % $_[0]},2],
           '**' => [sub {$_[1] ** $_[0]},3],
           'x' => [sub {$_[1] * $_[0]},9], # 多項式対応?
           '(' => [sub { },0],
       };
# 中置記法の引数をスペースで分割し後置記法に変換し計算を行う
print calc(infix_to_postfix(split (/\s+/,adjust(pop))));

sub infix_to_postfix{      # 中置記法を後置記法に変換
    my @post = ();                                                     # 後置記法用スタック
    my @opr = ();                                                      # 演算子用のワークスタック
    for ('(',@_,')'){                                                  # 中置記法の要素をカッコでくくり(処理を単純にする為)先頭から最後まで処理を行う。
        if ($_ eq ")"){                                                # 要素が閉じカッコの場合
            push @post,pop @opr while( @opr && $opr[-1] ne "(" );      #     開きカッコまで演算子用スタックから要素を取出し後置記法用スタックに積む。
            pop @opr;                                                  #     開きカッコを読み捨てる。
        }elsif(exists $op->{$_}){                                      # 要素が演算子の場合
                                                                       #     要素が開きカッコでなく要素のプライオリティが低い間、
                                                                       #     演算子スタックを取出し後置記法用スタックに積む。
            push @post,pop @opr while($_ ne "(" && @opr && $op->{$_}->[1] <= $op->{$opr[-1]}->[1]);
            push @opr,$_;                                              #     要素を演算子スタックに積む。
        }else{                                                         # 要素が演算子以外の場合
            push @post,$_;                                             #     要素を後置記法用スタックに積む。     
        }
    }
    return @post;                                                      # 後置記法用スタックを返却する。
}
sub calc {                 # 逆ポーランド記法の計算
    my @stack = ();
                                                                       # 1.逆ポーランド記法の要素を先頭から最後まで処理を行う。
                                                                       # 2.要素が演算子の場合にスタックから2つの要素を取出し計算結果をスタックに積む。
                                                                       # 3.要素が演算子でない場合に要素をスタックに積む。
    push @stack,(exists $op->{$_} ?  $op->{$_}->[0](pop @stack,pop @stack) : $_) for @_;
    return pop @stack;                                                 # スタックから要素を取出し返却する。
}
sub adjust{
    my $text = shift;
    $text =~ s{([\-\+\*\/\%\(\)x])}{ $1 }g;
    $text =~ s{\s+}{ }g;
    $text =~ s{\* \*}{\*\*}g;
    $text =~ s{(\D\s+)\- (\d)}{$1 -$2}g;
    $text =~ s{([\d\)]\s+)\(}{$1 x (}g;    # 多項式対応?
    return $text;
} 
 

 

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

とりあえず素のメンテ作成。cssJavaScript (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は使わないが(まだ)これをインストールすればwindowsbash,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は使わないが(まだ)これをインストールすればwindowsbash,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)

perlLISP…」と思っていたら「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日間でした。(タンブラー格好良いね)

夏祭り終わり…シュルシュルシュル~ドッカーン!!!