m_shige1979のときどきITブログ

プログラムの勉強をしながら学習したことや経験したことをぼそぼそと書いていきます

Github(変なおっさんの顔でるので気をつけてね)

https://github.com/mshige1979

perlの復習(配列やハッシュ)

時々Perlのソースを見ていくと?というソースがある

Perlの配列やハッシュを引数で設定しているからでした。

ちょっと簡略化すると以下のような感じ

配列

sample1.pl
#!/usr/bin/env perl
use strict;                                                                                                                                            
use warnings;                                                                                                                                          
use Data::Dumper;                                                                                                                                      
                                                                                                                                                       
sub test1{
  my @list = @_;
 
  print "test1 start\n";
  print Dumper(@list);
  print "test1 end\n\n"
}                                                                                                                                                    
                                                                                                                                                       
# type1
test1("111", "222", "333");                                                                                                                            
                                                                                                                                                       
# type2                                                                                                                                                
my @list1 = qw/aaa bbb/;                                                                                                                               
test1(@list1, "ccc");                                                                                                                                  
                                                                                                                                                       
# type3                                                                                                                                                
my @list2 = ("xxx", "yyy", "zzz");                                                                                                                     
test1(@list2);                                                                                                                                         
                                                                                                                                                       
#type4                                                                                                                                                 
my $list3 = ["abc", "def", "ghi"];                                                                                                                     
test1(@{$list3});        

$ perl test1.pl                                                                                                                          
test1 start
$VAR1 = '111';
$VAR2 = '222';
$VAR3 = '333';
test1 end
 
test1 start
$VAR1 = 'aaa';
$VAR2 = 'bbb';
$VAR3 = 'ccc';
test1 end
 
test1 start
$VAR1 = 'xxx';
$VAR2 = 'yyy';
$VAR3 = 'zzz';
test1 end
 
test1 start
$VAR1 = 'abc';
$VAR2 = 'def';
$VAR3 = 'ghi';
test1 end
 
mshige1979: ~ $ 

今までの手法の場合はtype1のように関数(サブルーチン)に1つずつに変数を設定して引数を渡すことを行っていたわけですが、Perlの場合は配列やハッシュで受け取れるので…

ハッシュ

sample3.pl
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
 
sub test1{
  my %hash = @_;
 
  print "test1 start \n";
  for my $key (keys %hash){
    print "$key:" . $hash{$key} . "\n";
  }
  print "test1 end\n\n";
 
}
 
# type1
test1(
  aaa => 100,
  bbb => 200,
  ccc => 300
);
 
# type2
my %hash1 = (
  xxx => 777,
  yyy => 888,
);
test1(
  %hash1,
  zzz => 999,
);
 
# type3                                                                                                                                                
my %hash2 = (
  abc => 123,
  def => 456,
  ghi => 789
);
test1(%hash2);

$ perl test3.pl                                                                                                                          
test1 start 
ccc:300
aaa:100
bbb:200
test1 end
 
test1 start 
yyy:888
zzz:999
xxx:777
test1 end
 
test1 start 
abc:123
ghi:789
def:456
test1 end
$

一部だけハッシュや配列で固められているとちょっととまどいそうだけどまあ、やっと理解してきた感じ
cpanのソースやいろいろな場所のサンプルソースはこの書き方が普通に行われているので意識しておく必要がありそうです

Amon2のフレームワークを触ってみる

別に

Mojoliciousに飽きたわけではない。他のフレームワークにも触れておく必要があると感じだけ

インストール

cpanm Amon2

フレームワークなので入れるものが非常に多い

なんかamon2-setup.pl が使用できるようになったみたい

$ amon2-setup.pl 
Usage:
        % amon2-setup.pl MyApp

            --flavor=Basic      basic flavour (default)
            --flavor=Lite       Amon2::Lite flavour (need to install)
            --flavor=Minimum    minimalistic flavour for benchmarking
            --flavor=Standalone CPAN uploadable web application(EXPERIMENTAL)

            --vc=Git         setup the git repository (default)

            --list-flavors (or -l) Shows the list of flavors installed

            --help   Show this help

$

最初はベーシックで作成

$ amon2-setup.pl MyApp1 --flavor=Basic
-- Running flavor: Basic --
[main] Loading asset: jQuery
[main] Loading asset: Bootstrap
[main] Loading asset: ES5Shim
[main] Loading asset: MicroTemplateJS
[main] Loading asset: StrftimeJS
[main] Loading asset: SprintfJS
[main] Loading asset: MicroLocationJS
[main] Loading asset: MicroDispatcherJS
[main] Loading asset: XSRFTokenJS
[Flavor::Basic] writing tmpl/index.tx
[Flavor::Basic] writing tmpl/include/layout.tx
[Flavor::Basic] writing tmpl/include/pager.tx
[Flavor::Basic] writing lib/MyApp1.pm
[Flavor::Basic] writing lib/MyApp1/Web.pm
[Flavor::Basic] writing lib/MyApp1/Web/Plugin/Session.pm
[Flavor::Basic] writing lib/MyApp1/Web/Dispatcher.pm
[Flavor::Basic] writing lib/MyApp1/Web/View.pm
[Flavor::Basic] writing lib/MyApp1/Web/ViewFunctions.pm
[Flavor::Basic] writing lib/MyApp1/DB.pm
[Flavor::Basic] writing lib/MyApp1/DB/Schema.pm
[Flavor::Basic] writing lib/MyApp1/DB/Row.pm
[Flavor::Basic] writing script/myapp1-server
[Flavor::Basic] writing Build.PL
[Flavor::Basic] writing minil.toml
[Flavor::Basic] writing builder/MyBuilder.pm
[Flavor::Basic] writing cpanfile
[Flavor::Basic] writing static//js/jquery-2.1.1.min.js
[Flavor::Basic] writing static//bootstrap/fonts/glyphicons-halflings-regular.ttf
[Flavor::Basic] writing static//bootstrap/css/bootstrap-theme.css.map
[Flavor::Basic] writing static//bootstrap/css/bootstrap-theme.min.css
[Flavor::Basic] writing static//bootstrap/js/bootstrap.js
[Flavor::Basic] writing static//bootstrap/fonts/glyphicons-halflings-regular.woff
[Flavor::Basic] writing static//bootstrap/js/bootstrap.min.js
[Flavor::Basic] writing static//bootstrap/css/bootstrap-theme.css
[Flavor::Basic] writing static//bootstrap/css/bootstrap.min.css
[Flavor::Basic] writing static//bootstrap/fonts/glyphicons-halflings-regular.svg
[Flavor::Basic] writing static//bootstrap/css/bootstrap.css
[Flavor::Basic] writing static//bootstrap/fonts/glyphicons-halflings-regular.eot
[Flavor::Basic] writing static//bootstrap/css/bootstrap.css.map
[Flavor::Basic] writing static//js/es5-shim.min.js
[Flavor::Basic] writing static//js/micro_template.js
[Flavor::Basic] writing static//js/strftime.js
[Flavor::Basic] writing static//js/sprintf.js
[Flavor::Basic] writing static//js/micro-location.js
[Flavor::Basic] writing static//js/micro_dispatcher.js
[Flavor::Basic] writing static//js/xsrf-token.js
[Flavor::Basic] writing static/img/.gitignore
[Flavor::Basic] writing static/robots.txt
[Flavor::Basic] writing static/js/main.js
[Flavor::Basic] writing static/css/main.css
[Flavor::Basic] writing db/.gitignore
[Flavor::Basic] writing config/development.pl
[Flavor::Basic] writing config/production.pl
[Flavor::Basic] writing config/test.pl
[Flavor::Basic] writing sql/mysql.sql
[Flavor::Basic] writing sql/sqlite.sql
[Flavor::Basic] writing t/Util.pm
[Flavor::Basic] writing t/00_compile.t
[Flavor::Basic] writing t/01_root.t
[Flavor::Basic] writing t/02_mech.t
[Flavor::Basic] writing t/03_assets.t
[Flavor::Basic] writing t/06_jshint.t
[Flavor::Basic] writing xt/01_pod.t
[Flavor::Basic] writing xt/02_perlcritic.t
[Flavor::Basic] writing .gitignore
[Flavor::Basic] writing .proverc
[Flavor::Basic] writing static/500.html
[Flavor::Basic] writing static/503.html
[Flavor::Basic] writing static/502.html
[Flavor::Basic] writing static/504.html
[Flavor::Basic] writing static/404.html
Initialized empty Git repository in /vagrant/perl/amon2/MyApp1/.git/
[master (root-commit) b0548a1] initial import
 62 files changed, 10636 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 .proverc
 create mode 100644 Build.PL
 create mode 100644 builder/MyBuilder.pm
 create mode 100644 config/development.pl
 create mode 100644 config/production.pl
 create mode 100644 config/test.pl
 create mode 100644 cpanfile
 create mode 100644 db/.gitignore
 create mode 100644 lib/MyApp1.pm
 create mode 100644 lib/MyApp1/DB.pm
 create mode 100644 lib/MyApp1/DB/Row.pm
 create mode 100644 lib/MyApp1/DB/Schema.pm
 create mode 100644 lib/MyApp1/Web.pm
 create mode 100644 lib/MyApp1/Web/Dispatcher.pm
 create mode 100644 lib/MyApp1/Web/Plugin/Session.pm
 create mode 100644 lib/MyApp1/Web/View.pm
 create mode 100644 lib/MyApp1/Web/ViewFunctions.pm
 create mode 100644 minil.toml
 create mode 100644 script/myapp1-server
 create mode 100644 sql/mysql.sql
 create mode 100644 sql/sqlite.sql
 create mode 100644 static/404.html
 create mode 100644 static/500.html
 create mode 100644 static/502.html
 create mode 100644 static/503.html
 create mode 100644 static/504.html
 create mode 100644 static/bootstrap/css/bootstrap-theme.css
 create mode 100644 static/bootstrap/css/bootstrap-theme.css.map
 create mode 100644 static/bootstrap/css/bootstrap-theme.min.css
 create mode 100644 static/bootstrap/css/bootstrap.css
 create mode 100644 static/bootstrap/css/bootstrap.css.map
 create mode 100644 static/bootstrap/css/bootstrap.min.css
 create mode 100644 static/bootstrap/fonts/glyphicons-halflings-regular.eot
 create mode 100644 static/bootstrap/fonts/glyphicons-halflings-regular.svg
 create mode 100644 static/bootstrap/fonts/glyphicons-halflings-regular.ttf
 create mode 100644 static/bootstrap/fonts/glyphicons-halflings-regular.woff
 create mode 100644 static/bootstrap/js/bootstrap.js
 create mode 100644 static/bootstrap/js/bootstrap.min.js
 create mode 100644 static/css/main.css
 create mode 100644 static/img/.gitignore
 create mode 100644 static/js/es5-shim.min.js
 create mode 100644 static/js/jquery-2.1.1.min.js
 create mode 100644 static/js/main.js
 create mode 100644 static/js/micro-location.js
 create mode 100644 static/js/micro_dispatcher.js
 create mode 100644 static/js/micro_template.js
 create mode 100644 static/js/sprintf.js
 create mode 100644 static/js/strftime.js
 create mode 100644 static/js/xsrf-token.js
 create mode 100644 static/robots.txt
 create mode 100644 t/00_compile.t
 create mode 100644 t/01_root.t
 create mode 100644 t/02_mech.t
 create mode 100644 t/03_assets.t
 create mode 100644 t/06_jshint.t
 create mode 100644 t/Util.pm
 create mode 100644 tmpl/include/layout.tx
 create mode 100644 tmpl/include/pager.tx
 create mode 100644 tmpl/index.tx
 create mode 100644 xt/01_pod.t
 create mode 100644 xt/02_perlcritic.t
--------------------------------------------------------------

Setup script was done! You are ready to run the skelton.

You need to install the dependencies by:

    > carton install

And then, run your application server:

    > carton exec perl -Ilib script/myapp1-server

--------------------------------------------------------------
$
不足するモジュールをインストール
cd MyApp1/
carton install
起動
$ carton exec perl -Ilib script/myapp1-server
MyApp1: http://127.0.0.1:5000/


f:id:m_shige1979:20141211002846p:plain
※起動しない?

IPが異なるからプライベートIP指定したけどダメらしい
のでIPを変更する

script/myapp1-server
#!perl
use strict;
use warnings;
use utf8;
use File::Spec;
use File::Basename;
use lib File::Spec->catdir(dirname(__FILE__), '../lib');
use Plack::Builder;

use MyApp1::Web;
use MyApp1;
use URI::Escape;
use File::Path ();

my $app = builder {
    enable 'Plack::Middleware::Static',
        path => qr{^(?:/static/)},
        root => File::Spec->catdir(dirname(__FILE__), '..');
    enable 'Plack::Middleware::Static',
        path => qr{^(?:/robots\.txt|/favicon\.ico)$},
        root => File::Spec->catdir(dirname(__FILE__), '..', 'static');
    enable 'Plack::Middleware::ReverseProxy';

    MyApp1::Web->to_app();
};
unless (caller) {
    my $port        = 5000;
    # my $host        = '127.0.0.1';
    my $host        = '192.168.33.10';
    my $max_workers = 4;

    require Getopt::Long;
    require Plack::Loader;
    my $p = Getopt::Long::Parser->new(
        config => [qw(posix_default no_ignore_case auto_help)]
    );
    $p->getoptions(
        'p|port=i'      => \$port,
        'host=s'        => \$host,
        'max-workers=i' => \$max_workers,
        'version!'      => \my $version,
        'c|config=s'    => \my $config_file,
    );
    if ($version) {
        print "MyApp1: $MyApp1::VERSION\n";
        exit 0;
    }
    if ($config_file) {
        my $config = do $config_file;
        Carp::croak("$config_file: $@") if $@;
        Carp::croak("$config_file: $!") unless defined $config;
        unless ( ref($config) eq 'HASH' ) {
            Carp::croak("$config_file does not return HashRef.");
        }
        no warnings 'redefine';
        no warnings 'once';
        *MyApp1::load_config = sub { $config }
    }

    print "MyApp1: http://${host}:${port}/\n";

    my $loader = Plack::Loader->load('Starlet',
        port        => $port,
        host        => $host,
        max_workers => $max_workers,
    );
    return $loader->run($app);
}
return $app;

再度起動

$ carton exec perl -Ilib script/myapp1-server 
MyApp1: http://192.168.33.10:5000/


f:id:m_shige1979:20141211003218p:plain

ちゃんとでた
出ないからちょっと焦りました(^_^;)

所感

今回はセットアップまで他にもフレームワークはあるけどとりあえずこれを触ってみる。
perlの勉強会にいくとよく聞くフレームワークなのでちょっといろいろ調べて見よう

Perl入学式に参加した感想&その後ちょっと作ったMojoliciousのサイト

Perl入学式 Advent Calendar 2014の12月16日(火)の記事です。
昨日はpapixさんのReplyでお手軽にPerlのコードを動かす話でした。

Perlの対話型環境は始めて聞きました。ちょっと触ってみようかと思います。

ここではPerl入学式への参加したことやその感想などを記載していきます。
あとついでに作ったサイト(超しょぼい)の説明とか…





入学式について

参加してよかったこと

Perlについて本当の基礎から学ぶことができた。
正規表現が組めないと使えないイメージしかないからなかなか手を付けることが出来なかった。
入学式に参加して基礎から学ぶ機会を与えられたのでPerlについて興味をもつきっかけを得ることができました。
まだ、あんまり理解していないけど…

本当に最初から学ぶことができる

プログラミングの初心者でも他の言語を知ってても最初から学べる。内容によっては時間が足りないこともあるのがネックかな?と思うくらい。

サポーターが意外と多い

ハンズオンとかの場合は大抵2~3人、または4~5人辺りでしたけど私が参加した時は入学式参加者全員がすぐに聞ける状態でしたのでわからないことはすぐに聞きやすかったと思います。

Perlの情報を集めやすくなった

cpanはいまいち読めんけどいろいろなところと組み合わせればなんとかなる。
twitterや他のコミュニティサイトで質問してくれたら教えてくれるところも嬉しい。

2014年度は参加は未定中

基本、2013年のYAPCから参加し始めて最後までいたので独学でできそうなところは自分でなんとかしたほうがいいと思いましたし、勉強会の空き席の状況がほとんどなかったので盛況なんだなと思いました。
ただ、他の勉強会がある場合は時間を調整して参加しています。


実は参加するかどうかでかなり悩んだ

IT系のコミュニティとか勉強会とかは私の回りの人間は誰も参加していないので「参加するべきか?」とか「敷居高い?」とか「いまさらやるべきじゃない?」などの考えが結構でて申し込みを行うのは結構ギリギリまて時間をかけてしまいました。

作ったWebサイト

注意

期待しないで、想像しているより300%以上しょぼいです。

どんなサイト

8月下旬に痛風になってしまいまして。プリン体ってなんぞや?ということから同じように痛風になっている人やプリン体がどんなものに含まれているのかを軽くまとめたサイトです。専門的な知識はないのでいくつかのサイトを巡って得た情報を出してるだけですけど…

作成する上でベースとしたもの

http://yusuke.be/post/80142082560

画面

画面では痛風患者の統計とか出す
f:id:m_shige1979:20141203215446p:plain

画像をクリックするとプリン体含有量のリストを表示
f:id:m_shige1979:20141203215458p:plain

環境

サーバ

CentOS

データベース

MySQL

JS

AngularJS

CSS

Twitter Bootstrap

起動アプリ

Starman
supervisor

アプリケーション構成

以下のコマンドで簡単なアプリを構成

mojo generate app Tufu::Web

ソースコードは実際
https://github.com/mshige1979/tufuapi
を見たほうが速いかも

ファイル構成

.
├── config.pl
├── env
│   ├── sass
│   │   ├── config.rb
│   │   ├── images
│   │   ├── sass
│   │   │   └── app.scss
│   │   └── stylesheets
│   │       ├── ie.css
│   │       ├── print.css
│   │       └── screen.css
│   └── sql
│       ├── alter.sql
│       ├── beer_insert.sql
│       ├── ddl.sql
│       └── food_insert2.sql
├── lib
│   └── Tufu
│       ├── Config
│       │   └── App.pm
│       ├── DB
│       │   └── Schema.pm
│       ├── DB.pm
│       ├── Model
│       │   ├── App.pm
│       │   ├── Beer.pm
│       │   ├── Food.pm
│       │   └── StatisticsNum.pm
│       ├── Model.pm
│       ├── Web
│       │   ├── App.pm
│       │   └── Root.pm
│       └── Web.pm
├── log
├── public
│   ├── css
│   │   ├── app.css
│   │   ├── bootstrap.css
│   │   ├── bootstrap.css.map
│   │   ├── bootstrap.min.css
│   │   ├── bootstrap-theme.css
│   │   ├── bootstrap-theme.css.map
│   │   └── bootstrap-theme.min.css
│   ├── favicon.ico
│   ├── fonts
│   │   ├── glyphicons-halflings-regular.eot
│   │   ├── glyphicons-halflings-regular.svg
│   │   ├── glyphicons-halflings-regular.ttf
│   │   └── glyphicons-halflings-regular.woff
│   ├── icon_image.png
│   ├── img
│   │   ├── draft_beer_t.png
│   │   └── tama02.jpg
│   └── js
│       ├── angular-animate.js
│       ├── angular-animate.min.js
│       ├── angular-animate.min.js.map
│       ├── angular.js
│       ├── angular.min.js
│       ├── angular.min.js.map
│       ├── angular-resource.js
│       ├── angular-resource.min.js
│       ├── angular-resource.min.js.map
│       ├── angular-route.js
│       ├── angular-route.min.js
│       ├── angular-route.min.js.map
│       ├── angular-touch.js
│       ├── angular-touch.min.js
│       ├── angular-touch.min.js.map
│       ├── app.js
│       ├── bootstrap.js
│       ├── bootstrap.min.js
│       ├── jquery-2.1.1.js
│       ├── jquery-2.1.1.min.js
│       └── jquery-2.1.1.min.map
├── script
│   └── tufu_web
├── t
│   └── basic.t
└── templates
    ├── exception.production.html.ep
    ├── layouts
    │   └── default.html.ep
    ├── not_found.production.html.ep
    └── root
        ├── index.html.ep
        ├── item1.html.ep
        ├── item2.html.ep
        └── main.html.ep

liteじゃないほうでMojoliciousを作成したほうがテンプレートのファイルなどがわかれているので管理はし易いと思います。
それにしても実際使用していないファイルが結構あるw

実装を一部記載

ここで簡単にコントローラーのルーティングの設定やキャッシュ設定を行いました

lib/Tufu/Web.pm
package Tufu::Web;
use Mojo::Base 'Mojolicious';

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

  # Documentation browser under "/perldoc"
  $self->plugin('PODRenderer');

  $self->app->hook(before_routes => sub {
    my $c = shift;
    $c->req->headers->if_modified_since(
        'Thu, 01 Jun 1970 00:00:00 GMT'
    );
  });

  # Router
  my $r = $self->routes;

  # Normal route to controller
  $r->get('/')->to('root#index');
  $r->get('/templates/main.html')->to('root#main');
  $r->get('/templates/item1.html')->to('root#item1');
  $r->get('/templates/item2.html')->to('root#item2');

  # api用
  $r->get('/api/food')->to('app#food');
  $r->get('/api/beer')->to('app#beer');
  $r->get('/api/dataGraph')->to('app#dataGraph');

  # 画面をリロードした場合の対策
  $r->get('/item1')->to('root#item');
  $r->get('/item2')->to('root#item');

データベース設定
Tengなどを使用するので定義

lib/Tufu/DB.pm
package Tufu::DB;
use parent 'Teng';
__PACKAGE__->load_plugin('SearchBySQLAbstractMore');
1;

データベースのスキーマ定義
Tengで使用するためのテーブルを設定

lib/Tufu/DB/Schema.pm
package Tufu::DB::Schema;
use strict;
use warnings;
use Teng::Schema::Declare;
use utf8;
use Encode;

table{
    name 'food';
    pk   'id';
    columns qw/id kind item_name prin_value unit_name/;

};

table{
    name 'beer';
    pk   'id';
    columns qw/id maker kind item_name alcohol_content prin_value unit_name/;

};

table{
    name 'statistics_num';
    pk   'year';
    columns qw/year num_gk num_male num_female/;

};

1;


モデル設定
接続処理などの共通部分を設定

lib/Tufu/Model.pm
package Tufu::Model{
    use Mouse;
    use Tufu::DB;
    use Tufu::Config::App;

    has 'db' => (
        is => 'ro',
        isa => 'Tufu::DB',
        lazy_build => 1
    );

    has 'connect_info' => (
        is => 'ro',
        isa => 'ArrayRef',
        lazy_build => 1
    );

    sub _build_connect_info{
        my $self = shift;
        Tufu::Config::App::config->{connect_info};
    }

    sub _build_db{
        my $self = shift;

        Tufu::DB->new(
            connect_info => $self->connect_info
        );

    }

    __PACKAGE__->meta->make_immutable();
}

1;

プリン体データ取得コントローラー
データ取得用のモデルを使用してデータをjsonで返却

lib/Tufu/Web/App.pm
package Tufu::Web::App;
use Mojo::Base 'Mojolicious::Controller';

use Tufu::Model::Food;
use Tufu::Model::Beer;
use Tufu::Model::StatisticsNum;
use Data::Dumper;

sub food {
   # パラメータ指定
   my $self = shift;
   my $log = $self->app->log;

   $log->debug("food start");

   my $model = new Tufu::Model::Food();
   my $list = $model->find();

   $log->debug(Dumper($list));
   $log->debug("food end");

   # json指定
   $self->render(json => $list);
 }

 sub beer {
   # パラメータ指定
   my $self = shift;
   my $log = $self->app->log;

   $log->debug("beer start");

   my $model = new Tufu::Model::Beer();
   my $list = $model->find();
   $log->debug(Dumper($list));

   $log->debug("beer end");

   # json指定
   $self->render(json => $list);
 }

sub dataGraph {
   # パラメータ指定
   my $self = shift;
   my $log = $self->app->log;

   $log->debug("dataGraph start");

   my $model = new Tufu::Model::StatisticsNum();
   my $list = $model->find();
   $log->debug(Dumper($list));

   $log->debug("dataGraph end");

   $self->render(json => $list);
}

1;

データ取得モデル

lib/Tufu/Model/Beer.pm
package Tufu::Model::Beer{
    use Mouse;
    use Tufu::Model::App;

    extends Tufu::Model::App;

    has 'table' => (
        is => 'ro',
        isa => 'Str',
        default => 'beer'
    );

    sub find{
        my ($self) = @_;

        my $data;
        my $list = [];

        # 全件取得
        $data = $self->db->search($self->table, {});

        # ハッシュ型で設定
        while(my $row = $data->next()){
            push @{$list}, {
                id => $row->id,
                maker => $row->maker,
                kind => $row->kind,
                item_name => $row->item_name,
                alcohol_content => $row->alcohol_content,
                prin_value => $row->prin_value,
                unit_name => $row->unit_name
            };
        }

        # 結果返却
        return $list;

    }

    __PACKAGE__->meta->make_immutable();

}

ついでにjsも

app.js
google.load('visualization', '1', {
    packages: ['corechart']
});

google.setOnLoadCallback(function() {
    angular.bootstrap(document.body, ['tufuApp']);
});

var tufuApp = angular.module('tufuApp', ['ngRoute', 'ngAnimate']);

tufuApp.config(function($routeProvider, $locationProvider){

    $routeProvider.when('/', {
        templateUrl: "templates/main.html",
        controller: MainController

    }).when('/item1', {
        templateUrl: "templates/item1.html",
        controller: Page1Controller

    }).when('/item2', {
        templateUrl: "templates/item2.html",
        controller: Page2Controller

    }).otherwise({
        redirectTo: '/'
    });

});

tufuApp.config(function($locationProvider){
    $locationProvider.html5Mode({
        enabled: true,
        requireBase: false
    });
});

tufuApp.controller('NaviController', NaviController);
tufuApp.controller('GraphController', GraphController);

function MainController($scope, $http){

}

function Page1Controller($scope, $http){
    $http({
        method: 'get',
        url: '/api/food',
        withCredentials: true
    }).success(function(data) {
        $scope.food_list = data;

    }).error(function(data, status) {
        alert('通信エラーが発生しました');

    });
}

function Page2Controller($scope, $http){
    $http({
        method: 'get',
        url: '/api/beer',
        withCredentials: true
    }).success(function(data) {
        $scope.beer_list = data;

    }).error(function(data, status) {
        alert('通信エラーが発生しました');

    });
}

function NaviController($scope){
    $scope.link = function(){
        location.href = "/";
    }
}

function GraphController($scope, $http){

    $http({
        method: 'get',
        url: '/api/dataGraph',
        withCredentials: true
    }).success(function(dataList) {
        var data = new google.visualization.DataTable();

        data.addColumn('string', '年');
        data.addColumn('number', '合計');
        data.addColumn('number', '男性');
        data.addColumn('number', '女性');
        data.addRows(
            dataList
        );

        var ac = new google.visualization.ComboChart(document.getElementById('chart_div'));

        ac.draw(data,
            {
                "title" : '通院者数推移(千人)',
                "hAxis": {
                    "title": "年"
                },
                "seriesType": "bars", // 全体は棒グラフ(default='line')
                "isStacked": true,
                "series": {
                    "0": {"type": "line"}
                } // 平均だけ折れ線グラフ });
            }
        );

    }).error(function(data, status) {
        alert('通信エラーが発生しました');

    });
}

つまづいたこと

エラー画面どうしよう

▶ templatesにexception.production.html.epとかnot_found.production.html.epで対応しようかな

configファイルにパスワードとか入れるべき?

▶ 環境変数で対応して様子見

angularjsわからん

▶ がんばろう少しずつ理解していくようにする

Perlのモデルの使い方がなんかちがうかも

▶ 慣れていけばもっといい方法が見つかると思う。基本はテンプレートメソッドとかシングルトンでなんとかしよう(なってないかもしれん)

内容とかデザインしょぼい(´・ω・`)

▶ センスって重要ですな

今後の状況

まだまだ、perlに慣れていないのでもっと勉強する必要が必要。
どのような感じで作成するのがベストであるかはcpanなどを見て勉強していきます。
あと健康にも気をつけよう

おまけ

アドベントカレンダーが始まったのである程度のデータを集めてサイトを作成
https://serene-springs-4867.herokuapp.com/
※遅いです

おまけまーくつー

http://app1.mshige1979tools1.net/
※使ってて虚しくなります

まとめ

Perlを使いこなすには正規表現は必要ですけど、正規表現が全くわからなくでもPerlを使うことはできます。まあ、できたほうが断然便利なんで勉強はちょくちょくやるかも



以上

perlでAnyEvent::Twitter::Streamを使用して取得

AnyEvent::Twitter::Stream

sample.pl
#/usr/bin/env perl

use strict;
use warnings;
use AnyEvent::Twitter::Stream;
use utf8;
use Data::Dumper;
use Time::Local;

binmode STDOUT, ":utf8";

my $consumer_key = "consumer_key";
my $consumer_secret = "consumer_secret";
my $access_token = "access_token";
my $access_token_secret = "access_token_secret";


sub timestamp2date {
    my $timestamp = shift;
    my ($sec, $min, $hour, $day, $mon, $year) = localtime($timestamp / 1000);
    return sprintf('%04d-%02d-%02d %02d:%02d:%02d', $year + 1900, $mon + 1, $day, $hour, $min, $sec);
}

my $done = AE::cv;

my $listener = AnyEvent::Twitter::Stream->new(
    consumer_key    => $consumer_key,
    consumer_secret => $consumer_secret,
    token           => $access_token,
    token_secret    => $access_token_secret,
    method   => 'filter',
    track    => "おはよう",
    on_tweet => sub {
        my $tweet = shift;
        my $_text = $tweet->{text};
        my $_lang = $tweet->{lang};

        # 改行除去
        $_text =~ s/(\r\n|\n\r|\n|\r)//g;

        # タイムスタンプを変換
        my $tm = $tweet->{timestamp_ms};
        my $date = timestamp2date($tm);
        print "$date $tweet->{user}->{name} $_text " . "\n";

    },
);

$done->recv;

2014-11-22 08:27:59 いつきんぐ @lhp134 おはよう 
2014-11-22 08:28:02 @nanda_gomi_life おはよう 171 
2014-11-22 08:28:02 おちゃ子 休日の朝はダメだな / おはよう http://t.co/MS33ZzWlyV 
2014-11-22 08:28:04 南 千秋 @rorigeta_501JFW おはよう ロリげた@アイコン変えた 二度寝は気持ちいいけど…起きような? 
2014-11-22 08:28:05 あ おはよ!つかれたおはよう疲れたただいまおやすみおやすー眠い起きるこんばんはこんにちはこんにちわさようなら死ぬ辛いむかつく楽しい嬉しい腹立つお腹すいた離脱ほかる風呂つらい6d060326 
2014-11-22 08:28:06 有頂天風霊夢bot @IBUKll おはよう おちゃ子。今日もいい日になるといいわね 
2014-11-22 08:28:06 あああ遊ぶなら博多人妻専科 人妻デリヘル こんにちは 
2014-11-22 08:28:08 一般人 おはよう 
2014-11-22 08:28:09 Be @culumiruku おはよう 
2014-11-22 08:28:10 スペースくん@お酒奢って @whatman_ おはよう 
2014-11-22 08:28:10 ☣ジョージ @moroegle おはよう 

こんな感じ

なんかちょっと違うかも?

searchで検索した結果と時間差や取得しているデータに差があるのでapiそのものに問題があるかもしれないので実際に使用するのは見送る感じになりそう…

perlでtwitterAPI(search、update)

メモ用

実際にやらないと覚えないので…
コピーをそのまま使用して動かないとかよくあるので…

準備

https://apps.twitter.com
へアクセスしてアプリの登録とキーを生成しておく
キーは書き込み可能なように対応

search

クエリーで検索してくれます

sample1.pl
#/usr/bin/env perl

use strict;
use warnings;
use Net::Twitter;
use utf8;
use Data::Dumper;
binmode STDOUT, ":utf8";

my $consumer_key = "<consumer_key>";
my $consumer_secret = "<consumer_secret>";
my $access_token = "<access_token>";
my $access_token_secret = "<access_token_secret>";

my $tw_app = Net::Twitter->new({
    traits => [qw/API::RESTv1_1/],
    consumer_key => $consumer_key,
    consumer_secret => $consumer_secret,
    access_token => $access_token,
    access_token_secret => $access_token_secret});

my $res = $tw_app->search({
    q => "痛風",
    lang => "ja",
    rpp => 100
});

foreach my $item(@{$res->{statuses}}){
    #print Dumper($item);
    my $_text = $item->{text};
    $_text =~ s/(\r\n|\n\r|\n|\r)//g;

    # 出力
    print "$item->{created_at} $item->{user}->{name} $_text " . "\n";
}

※自分で生成したキーを設定

$ perl sample1.pl
Fri Nov 21 13:38:01 +0000 2014 43すく8そぶ ソフトバンクいちろーは福井の43歳痛風デブハゲ公務員 → http://t.co/0QFKJphAAy @softbank_ichiro #SoftBank #au #docomo #kddi #Fukui #ペッパー #sbm_iphone6 @masason 
Fri Nov 21 13:28:40 +0000 2014 杉村こずえ とはいえ、首肩の痛み続く。目立った外傷はないが触れるだけでも痛む。ま、まさか。痛風ではないだろうな。 
Fri Nov 21 13:28:26 +0000 2014 S B T N 。 @nkd____sex 冷たいわあ 、痛風って 激痛やんけ … 、 
Fri Nov 21 13:25:56 +0000 2014 P氏@プライマルひこうき雲 痛風脱糞未遂スッキリロックスターもいるし、色々大変だな 
Fri Nov 21 13:21:32 +0000 2014 森髙 史也 RT @dekisugi__kun: 痛風ってね、この尿酸の結晶が血管流れて引き起こされるんだよ。人の命を刈る形をしてるやろ????? http://t.co/JSphGqmlsp 
Fri Nov 21 13:21:11 +0000 2014 生田 瞬 @may_315 自分用のモツをどこかに確保するなり、帰りに買っておくべきでしたね。しかし、モツの食べすぎは痛風の元とか聞いて、最近食ってませんわ。痛風でないけど。 
Fri Nov 21 13:20:41 +0000 2014 綾小路 真吾 http://t.co/s9MqlvcHu0 オジサンの病気だと思ってない?若者にも広がる"痛風"の恐怖 
Fri Nov 21 13:19:36 +0000 2014 おおえど 肉離れした逆の足の親指が痛いのだが、庇ったから痛いのか、とうとう痛風なのか、はたまた痛風なのかわからなくてガクブルなのです。 
Fri Nov 21 13:19:30 +0000 2014 a.k.a.チャズ|`*zωz)ノシ @Sakura_Yu_ki 痛風 
Fri Nov 21 13:18:28 +0000 2014 仕事大好き@知りたがり 風が吹いても痛いから痛風!そんなに痛みが辛い痛風の悩み解消で明るい生活を・・!http://t.c                                                  o/KQXQeZPg9e 
Fri Nov 21 13:16:07 +0000 2014 たい焼きマン 痛風発作なう((((´;ω;`)))) 
Fri Nov 21 13:10:13 +0000 2014 おざまい @tokumei_jieigyo 痛風には気をつけろよー( ̄∀ ̄) 
Fri Nov 21 13:08:19 +0000 2014 大分のらいむ(aya murai) 30歳代痛風になっちゃいましたな話題を聞いてプリン体含む食べ物摂りすぎと水分補給気をつけようと誓った。冬はこってり系美味しいし水分摂らないし。骨が折れたと思ったほど痛かったって。風が吹いても痛いの噂は伊達じゃないらしい。(*_*) 
Fri Nov 21 13:06:01 +0000 2014 43すく6そぶ ソフトバンクいちろーは福井の43歳痛風デブハゲ公務員 → http://t.co/dks1HFxSyC @softbank_ichiro #SoftBank #kddi #au #docomo #Fukui #ペッパー #sbm_iphone6 @masason 
Fri Nov 21 13:05:26 +0000 2014 エリック安田 斯く言う私も、かつてはうつ病患者の一人でした。胴回りが1mを超えるメタボ体型で幼い頃からアトピー性皮膚炎と慢性的なアレルギー性鼻炎に悩まされ続け、29歳の時に痛風も発症。物忘れが酷く常に頭はボンヤリ気味。二時間毎に缶コーヒーを飲まないと仕事が手につかない…そんな状態だったのです 
$ 

なるほど、こんな感じか…
参考にしたものと使用方法が微妙に異なるけど動くのでおk

update

ツイートするやつ

sample2.pl
#/usr/bin/env perl

use strict;
use warnings;
use Net::Twitter;
use utf8;
use Data::Dumper;
binmode STDOUT, ":utf8";

my $consumer_key = "<consumer_key>";
my $consumer_secret = "<consumer_secret>";
my $access_token = "<access_token>";
my $access_token_secret = "<access_token_secret>";

my $tw_app = Net::Twitter->new({
    traits => [qw/API::RESTv1_1/],
    consumer_key => $consumer_key,
    consumer_secret => $consumer_secret,
    access_token => $access_token,
    access_token_secret => $access_token_secret});

if (@ARGV == 1){
    my $text = $ARGV[0];
    print "tweet:$text\n";

    my $res = $tw_app->update($text);
    #print Dumper($res);

}else{
    print "なんかいれて\n";
}

[vagr$ perl sample2.pl bot_test
tweet:bot_test
$

f:id:m_shige1979:20141121225108p:plain

所感

botは意外と簡単に作成できるかもしれない。なんか気になるキーワードで検索して一致したものをツイートするとか…
ネットでいろいろあるけどなんかうまく腰が上がらなかったので今回やってみた。
twitter関連で動かすことはまだ、思いつかないけどいくつかチェックしておこう

Teng::Plugin::SearchBySQLAbstractMoreを試す

いろいろなモジュールがある

どれを使用することが正しいのかなんてわからないので適当にネットで検索したものを使用することにする
今回は集計とかしたかったので「Teng::Plugin::SearchBySQLAbstractMore」を検索しました

準備

cpanm
cpanm Teng::Plugin::SearchBySQLAbstractMore

構成

.
├── lib
│   ├── DB
│   │   └── Schema.pm
│   └── DB.pm
├── sample1.pl

ソース

lib/DB/Schema.pm
package DB::Schema;
use strict;
use warnings;
use Teng::Schema::Declare;

table{
    name 'posts';
    pk   'id';
    columns qw/id title body date age/;
};

1;

※これはいつもどおり

lib/DB.pm
package DB;
use parent 'Teng';
__PACKAGE__->load_plugin('SearchBySQLAbstractMore');
1;

プラグインをロードする

sample1.pl
#/usr/bin/env perl

use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/lib";
use DB;
use Data::Dumper;

my $obj;
$obj = DB->new(
    connect_info => ['dbi:mysql:sample_db3:localhost', 'root', undef ]
);


# 参照
my $data = $obj->search_by_sql_abstract_more(
    'posts',
    +{
        # 条件指定
        age => +{">=" => "25"}
    },
    +{
        # カラム
        -columns  => [
            'id'
            , 'title as bbb'
            , 'body as ccc'
            , 'date'
            , 'age'
        ],
        # 件数制御
        -limit => 3,

        # 並べ替え
        -order_by => [
            'age DESC',
            'id ASC'
        ],
    }
);
while(my $row = $data->next()){
    print Dumper($row->{row_data}) . "\n";
}

※パラメータの3つ目に追加の並べ替えやカラム名を設定

これでイケるらしい

distinctなどでユニークな行1件のみにしたい場合
#/usr/bin/env perl

use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/lib";
use DB;
use Data::Dumper;

my $obj;
$obj = DB->new(
    connect_info => ['dbi:mysql:sample_db3:localhost', 'root', undef ]
);


# 参照
my $data = $obj->search_by_sql_abstract_more(
    'posts',
    +{
        # 条件指定
        age => +{">=" => "10"}
    },
    +{
        # カラム
        -columns  => [
            'distinct date as date'
        ],
        # 件数制御
        -limit => 3,

        # 並べ替え
        -order_by => [
            'date DESC'
        ],
    }
);
while(my $row = $data->next()){
    print Dumper($row->{row_data}) . "\n";
}

※distinctなどを指定することもできる

group by
#/usr/bin/env perl

use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/lib";
use DB;
use Data::Dumper;

my $obj;
$obj = DB->new(
    connect_info => ['dbi:mysql:sample_db3:localhost', 'root', undef ]
);


# 参照
my $data = $obj->search_by_sql_abstract_more(
    'posts',
    +{
        # 条件指定
        age => +{">=" => "10"}
    },
    +{
        # カラム
        -columns  => [
            'date',
            'count(date) as count',
            'sum(age) as sum'
        ],
        # 件数制御
        -limit => 3,

        # グループ
        -group_by => [
            'date'
        ],

        # グループ条件
        -having => [
            'count' => {">=" => 3}
        ],

        # 並べ替え
        -order_by => [
            'date DESC'
        ],
    }
);
while(my $row = $data->next()){
    print Dumper($row->{row_data}) . "\n";
}

※グループ指定も可能

所感

searchメソッドではちょっとやりにくい場所もこれでできるようになった。あまりこういうのには手間を掛けたくないので
簡単に記載できるのは嬉しい。

モジュールを使用するのは便利だが、学習コストなどで手間がかかるのはやめたいとは思う

参考


鈍足ランナーのIT日記 Tengでgroup byやDateTimeをWhere句に書く方法

https://metacpan.org/pod/Teng::Plugin:


Teng::Plugin::SearchBySQLAbstractMore リリース - Practice of Programming

ソースみたけどよくわからんかった
うーん、勉強せな…

「−」がなんでキーについてんだよ、意味不明だ…

Mojoliciousでstashを使用する際、定義していないと…

概要

Mojoliciousではテンプレートで変数を割り当てる際はstashを使用する

サンプル
package Sample::Web::User;
use Mojo::Base 'Mojolicious::Controller';

# ログイン共通
sub init {
  my $self = shift;

  # ログイン処理独自のcssを設定
  $self->stash->{cssfiles} = ["user"];

}

# ログインページ
sub index {
  my $self = shift;

  # セッションをすべて破棄
  $self->session(expires => 1);

  # view適用
  $self->render();

}

1;

で割り当てる場合

<!DOCTYPE html>
<html>
  <head>
    <meta charset="utf-8" />
    <meta name="viewport" content="width=device-width, initial-scale=1">
    <link rel="stylesheet" href="/css/bootstrap.min.css">
    <link rel="stylesheet" href="/css/bootstrap-theme.min.css">

    <%# cssfilesが設定されている場合のみ処理を実行 %>
    % if($cssfiles) {
    %   for my $css (@{$cssfiles}) {
    <link rel="stylesheet" href="/css/<%= $css %>.css">
    %   }
    % }

    <title><%= title %></title>
  </head>
  <body>
    <div class="header">

    </div>
    <div class="container">
        <%= content %>
    </div>
    <div class="footer">

    </div>
    <script src="/js/jquery-2.1.1.min.js"></script>
    <script src="/js/bootstrap.min.js"></script>

  </body>
</html>

この場合の問題としては常に設定していないと

f:id:m_shige1979:20140816082111p:plain

こうなる

コントローラーに応じて設定しない場合もあることを考慮するとこの書き方ではダメのよう

こうする

<!DOCTYPE html>
<html>
  <head>
    <meta charset="utf-8" />
    <meta name="viewport" content="width=device-width, initial-scale=1">
    <link rel="stylesheet" href="/css/bootstrap.min.css">
    <link rel="stylesheet" href="/css/bootstrap-theme.min.css">

    <%# cssfilesが設定されている場合のみ処理を実行 %>
    % if(stash->{cssfiles}) {
    %   for my $css (@{stash->{cssfiles}}) {
    <link rel="stylesheet" href="/css/<%= $css %>.css">
    %   }
    % }

    <title><%= title %></title>
  </head>
  <body>
    <div class="header">

    </div>
    <div class="container">
        <%= content %>
    </div>
    <div class="footer">

    </div>
    <script src="/js/jquery-2.1.1.min.js"></script>
    <script src="/js/bootstrap.min.js"></script>

  </body>
</html>

※stashをそのまま使用することでエラーを回避できるようです

stashで定義していないことも考慮したテンプレート制御が必要な場合はstash->{xxxx}を使用する必要がありそうです。

所感

最近、「Mojolicious」という単語をコピペせずに入力いることにちょっと驚き、基本英語は苦手なのでスペルを覚えるのも大変だったけど意外をやっていくうちに覚えていくものだと実感した。