Translate

ラベル cpan の投稿を表示しています。 すべての投稿を表示
ラベル cpan の投稿を表示しています。 すべての投稿を表示

2013年8月18日日曜日

エラー情報は、発生行?呼出し行 warn/die or carp/croak

まずは、Debugモジュールを作成し、Printするメソッドを定義します。
ただし、Printする文字列がない時つまり引数が渡されなかったらエラーで終了としましょう!

use strict;                                                                              
use warnings;
use utf8;
use feature 'say';
binmode STDOUT, ":utf8";
binmode STDERR, ":utf8";

my $obj = Debug->new();
say $obj->Print("abc");
say $obj->Print("def");
say $obj->Print();
say $obj->Print("ghi");

package Debug;

sub new{                                                                                  
    return bless {}, shift;
}

sub Print{
    my ($self, $str) = @_;
    if (@_!=2){ die("引数を一つだけ指定してください") };

    return $str;
}

これを実行するとエラーで落ちます。
abc
def
引数を一つだけ指定してください at sample.pl line 22.

確かにエラーが発生した行の情報が表示されていて
これはこれで正しいのですが、あちこちから呼ばれる、データがトリガーとなって
エラーとなるケースでは呼び出しもとがどこなのか知りたいですよね。
つまり、呼び出しもとの行数を知りたい。
そんな時は、Carpモジュール。

use strict;                                                                              
use warnings;
use utf8;
use feature 'say';
binmode STDOUT, ":utf8";
binmode STDERR, ":utf8";

my $obj = Debug->new();
say $obj->Print("abc");
say $obj->Print("def");
say $obj->Print();
say $obj->Print("ghi");

package Debug;
use Carp;

sub new{                                                                                  
    return bless {}, shift;
}

sub Print{
    my ($self, $str) = @_;
    if (@_!=2){ croak("引数を一つだけ指定してください") };

    return $str;
}

実行結果:
abc
def
引数を一つだけ指定してください at sample.pl line 11.

引数を一つだけ指定してください。といわれ11行を確認すると
say $obj->Print();
ならば修正するのも楽ですね。

warnの代わりはcarpで
dieの代わりはcroakとなっています。

ロジックに問題の可能性があればwarnやdieを使い
呼び出し元がトリガーとなる場合carpやcroakを適宜使い分ければよいと思います。

2013年8月16日金曜日

Config::Simple

■簡単な設定ファイルを操作するモジュール

まずは設定ファイルを作成する
ファイル名:config
database = 'fizz'
user     = 'bazz'
pass     = 'fizzbazz'

ファイル名:Sample.pl
use strict;
use warnings;
use utf8;
use feature 'say';
use Config::Simple;
binmode STDOUT, ":utf8";

my $config = Config::Simple->new('./config');
say $config->param('database');
say $config->param('user');
say $config->param('pass'); 

実行結果:
fizz
bazz
fizzbazz

new する時に、ファイルパスを指定し、その後paramメソッドで値を取得することができるようです


ちょっとした物を記録しておき使うのであればこんな感じでよさそうですね。
ただ、同一のキー名を使用したい場合はセクションで区切ることで使い分けができます。
ファイル名:config
[001]
database = 'db001'
user     = 'user001'
pass     = 'pass001'

[002]
database = 'db002'
user     = 'user002'
pass     = 'pass002'

use strict;
use warnings;
use utf8;
use feature 'say';
use Config::Simple;
binmode STDOUT, ":utf8";

my $config = Config::Simple->new('./config');

say $config->param("001.database");
say $config->param("002.database");

実行結果:
db001
db002

今度は、paramメソッドで[セクション名].[キー名]を指定することで値にアクセスできます。

ちなみに、ハッシュ化することも可能で
オブジェクト->vars(); とすればできます。
use strict;
use warnings;
use utf8;  
use feature 'say';
use Config::Simple;
binmode STDOUT, ":utf8";
use Dumpvalue; my $d = Dumpvalue->new();

my $config = Config::Simple->new('./config01');
my $hash   = $config->vars();
$d->dumpValue($hash);

say $hash->{'001.user'};                                                           
say $hash->{'002.user'};

実行結果:
'001.database' => 'db001'
'001.pass' => 'pass001'
'001.user' => 'user001'
'002.database' => 'db002'
'002.pass' => 'pass002'
'002.user' => 'user002'
user001
user002


param関数とかじゃなくて、一発でハッシュに放り込んでくれると便利そうですね。
ということで他のConfig系のモジュールも探してみよう。

2012年4月8日日曜日

File::Find

■再帰的にディレクトリを移動して、ファイル/ディレクトリ名を取得する

.
├── 1
│   └── 2
│       └── 3.txt
├── a
│   └── b.txt
└── Sample.pl

上記構成を例に使用してみる。
■"1"ディレクトリの構成を調べる
#!/usr/bin/perl
use feature 'say';
use strict;
use warnings;
use utf8;
use File::Find;


find(\&wanted, '1');                                                                    

sub wanted{
  say "CurrentDirectory :", $File::Find::dir;
  say "Name             :", $_;
  say "FullPath         :", $File::Find::name;
  say "---";
}

実行結果:
CurrentDirectory :1
Name             :.
FullPath         :1
---
CurrentDirectory :1
Name             :2
FullPath         :1/2
---
CurrentDirectory :1/2
Name             :3.txt
FullPath         :1/2/3.txt
---



■複数のディレクトリを指定してみる
#!/usr/bin/perl
use feature 'say';
use strict;
use warnings;
use utf8;
use File::Find;


find(\&wanted, qw/1 a/); #配列で指定

sub wanted{
  say "CurrentDirectory :", $File::Find::dir;
  say "Name             :", $_;
  say "FullPath         :", $File::Find::name;
  say "---";
}

実行結果:
CurrentDirectory :1
Name             :.
FullPath         :1
---
CurrentDirectory :1
Name             :2
FullPath         :1/2
---
CurrentDirectory :1/2
Name             :3.txt
FullPath         :1/2/3.txt
---
CurrentDirectory :a
Name             :.
FullPath         :a
---
CurrentDirectory :a
Name             :b.txt
FullPath         :a/b.txt
---



■一番下の階層からスタートする
#!/usr/bin/perl
use feature 'say';
use strict;
use warnings;
use utf8;
use File::Find;


finddepth(\&wanted, '1');

sub wanted{
  say "CurrentDirectory :", $File::Find::dir;
  say "Name             :", $_;
  say "FullPath         :", $File::Find::name;
  say "---";
}

実行結果:
CurrentDirectory :1/2
Name             :3.txt
FullPath         :1/2/3.txt
---
CurrentDirectory :1
Name             :2
FullPath         :1/2
---
CurrentDirectory :1
Name             :.
FullPath         :1
---

FindBin

実行スクリプトのディレクトリを取得するモジュール

#!/usr/bin/perl
use feature 'say';
use strict;
use warnings;
use utf8;
use FindBin;
                                                        
say $FindBin::Bin;

libモジュールのパス指定をする際に利用すると便利。
use lib "$FindBin::Bin/lib";

File::Path

■ディレクトリの作成
カレントディレクトリにfoo/bar/bazなディレクトリ階層を作成したい時

下記構成
├── foo
│   └── bar
│   └── baz

#!/usr/bin/perl
use strict;
use warnings;
use utf8;

mkdir foo
mkdir foo/bar
mkdir foo/bar/baz
のように上位ディレクトリから順に作成していくことになる。

File::Pathを使うと1行ですむ。
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use File::Path qw/make_path/;

make_path('foo/bar/baz'); #ver 2.06以降


■ディレクトリの削除
下記ディレクトリ構造でfooディレクトリを削除したい時
├── foo
│   ├── bar
│   │   ├── baz
│   │   │   └── sample.txt
│   │   └── sample.txt
│   └── sample.txt
最下層のディレクトリ内のファイルを削除⇒ディレクトリ削除の順で削除する必要がある。
File::Findeモジュールのfinddepth関数で最下層のディレクトリからアクセスして削除していく
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use File::Find;
use FindBin;

finddepth(\&deleteAll, 'foo');

sub deleteAll{
  #フルパスじゃないと削除できなかったのでスクリプトのパスを取得しておく
  my $BasePath = $FindBin::Bin . '/';
  if(-f $_){ unlink $BasePath . $File::Find::name || die $! };
  if(-d $_){ rmdir  $BasePath . $File::Find::name || die $! };                          
}


File::Pathを使うと1行ですむ。
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use File::Path qw/remove_tree/;

remove_tree('foo'); #ver 2.06以降


v2.00より前とv2.06より前とそれ以降でインターフェースが異なります。
perl -MFile::Path -le 'print "$File::Path::VERSION"'
等で、確認した上で利用する必要があります。

v2.06以降の場合
use File::Path qw(make_path remove_tree);

  make_path('foo/bar/baz', '/zug/zwang'); #複数作成したい場合コンマで区切る
  make_path('foo/bar/baz', '/zug/zwang', {
      verbose => 1,  #1を指定すると実行時コマンドを出力する
      mode => 0711, #アクセス権限を指定  デフォ:0777
  });

  remove_tree('foo/bar/baz', '/zug/zwang');
  remove_tree('foo/bar/baz', '/zug/zwang', {
      verbose => 1,
      error  => \my $err_list, #エラー情報
  });

2012年3月11日日曜日

WebService::YahooJapan::WebMA

■Yahoo! 形態素解析APIを使ってみるメモ。
形態素解析APIを利用するにあたり、Yahooのアカウントと
AppIDを取得する必要があるので先に済ませておく。

1.Yahoo!のアカウントを取る。
https://login.yahoo.co.jp/config/login

2.どのページでもよいが、アプリケーションIDの登録をすませておく。
http://developer.yahoo.co.jp/webapi/jlp/ma/v1/parse.html

#!/usr/bin/perl
use feature 'say';
use strict;
use warnings;
use WebService::YahooJapan::WebMA;
use utf8;
use Dumpvalue; my $d = Dumpvalue->new();
binmode STDOUT, ":utf8";

my $AppID = '上記で取得しておいたアプリケーションIDを記載する';
$WebService::YahooJapan::WebMA::APIBase = 
         'http://jlp.yahooapis.jp/MAService/V1/parse';

my $api    = WebService::YahooJapan::WebMA->new( appid => $ApiID);
my $result = $api->parse(sentence => '本日は晴天なり') or die $api->error; #解析したい文章を指定する

$d->dumpValue($result);

'ma_result' => HASH(0x7fa5bbb28ec8)
   'filtered_count' => 4
   'total_count' => 4
   'word_list' => ARRAY(0x7fa5bbb1ee98)
      0  HASH(0x7fa5bbb25838)
         'pos' => '名詞'
         'reading' => 'ほんじつ'
         'surface' => '本日'
      1  HASH(0x7fa5bbb25880)
         'pos' => '助詞'
         'reading' => 'は'
         'surface' => 'は'
      2  HASH(0x7fa5bbb25670)
         'pos' => '名詞'
         'reading' => 'せいてん'
         'surface' => '晴天'
      3  HASH(0x7fa5bbb24718)
         'pos' => '助動詞'
         'reading' => 'なり'
         'surface' => 'なり'
'xmlns' => 'urn:yahoo:jp:jlp'
'xmlns:xsi' => 'http://www.w3.org/2001/XMLSchema-instance'
'xsi:schemaLocation' => 'urn:yahoo:jp:jlp http://jlp.yahooapis.jp/MAService/V1/parseResponse.xsd'

2012年3月3日土曜日

Time:Piece

■日時の取得
#!/usr/bin/perl
use feature 'say';
use strict;
use warnings;
use utf8;
use Time::Piece;
binmode STDOUT, ":utf8";


my $t = localtime;

### 日時の表示
say $t;              #Sat Mar  3 14:53:37 2012
say $t->datetime;    #2012-03-03T14:53:37
say $t->datetime(
         date => '/', 
         T    => ' ',
         time => '-'
                );   #2012/03/03 14-53-37
say $t->strftime('%Y*%m*%d  %H@%M@%S');
                     #2012*03*03  14@53@37  注:UTF8フラグが落ちてます


### 年月日の表示
say $t->ymd;      #2012-03-03
say $t->ymd("/"); #2012/03/03
say $t->ymd("");  #20120303

say $t->year;     #2012
say $t->mon;      #3
say $t->mday;     #3


### 曜日の表示
say $t->wday;      #7
say $t->wdayname;  #Sat
say $t->wdayname(
   qw/日 月 火 水 木 金 土/
                ); #土

#wdaynameを何度も使うのなら
#デフォルトの曜日を変更してしまう
$t->day_list(qw/日 月 火 水 木 金 土/);
say $t->wdayname;  #土


### 時分秒の表示
say $t->hms;      #14:53:37
say $t->hms("-"); #14-53-37
say $t->hms("");  #145337

say $t->hour;     #14
say $t->min;      #53
say $t->sec;      #37


### 他
#閏年判定
say $t->is_leap_year ? "閏年" : "Not閏年"; #閏年

#最終日
say $t->month_last_day; #31


### 任意の時間を設定
$t = localtime->strptime('2000-01-01 12:00:00', '%Y-%m-%d %H:%M:%S');
say $t->datetime; #2000-01-01T12:00:00


### 時間の比較
my $BaseDate = localtime->strptime('20001122', '%Y%m%d');
my $TestDate = localtime->strptime('20111122', '%Y%m%d');
say $BaseDate < $TestDate ? "もうすぎたよ" : "まだ過ぎてないよ";
                  #もうすぎだよ

### 時間の加減・減算(秒単位で返ってくる)
my $date1 = localtime->strptime('20120101', '%Y%m%d');
my $date2 = localtime->strptime('20130101', '%Y%m%d');
my $days  = ($date2 - $date1) / (24 * 60 * 60);
say $days;        #366

ただ、一つ注意。
strftimeメソッドは、utf8フラグを落とすことに注意。

#!/usr/bin/perl
use strict;
use warnings;
use Time::Piece;
use utf8;
use Devel::Peek;

my $t = localtime;
Dump $t->wdayname(qw/日 月 火 水 木 金 土/);
Dump $t->strftime('%Y年%m月%d日');

実行結果
SV = PV(0x7fd56b801170) at 0x7fd56b842708
  REFCNT = 1
  FLAGS = (TEMP,POK,pPOK,UTF8)
  PV = 0x105d08220 "\346\227\245"\0 [UTF8 "\x{65e5}"]
  CUR = 3
  LEN = 16
SV = PV(0x7fd56b801190) at 0x7fd56b842708
  REFCNT = 1
  FLAGS = (TEMP,POK,pPOK)
  PV = 0x105d06df0 "2012\345\271\26403\346\234\21004\346\227\245"\0
  CUR = 17
  LEN = 32

wdaynameメソッドの方には、UTF8フラグが残っているけど
strftimeメソッドの方には、UTF8フラグがないですよね。

上の例のように
binmode STDOUT, ":utf8";
して、標準出力する際にフラグを落とすようにしている場合
文字化けしちゃいます。

美しくないけど
binmode STDOUT, ":utf8"; するなら
use Encode;
say decode_utf8($t->strftimeメソッド);

のように内部にあるデータには徹底してフラグをつけるか

binmode STDOUT, ":utf8"; を使わないなら
use Encode;
say encode_utf8($t->strftime以外のメソッド);
say $t->strftimeメソッド;

とするしかないのかな…。


おまけ。
1日後、1ヶ月後を簡単に求めるのに
Time::Secondsを使う方法があります。

#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use feature 'say';
use Time::Piece;
use Time::Seconds;

my $t = localtime;
say $t->ymd; #2012-03-03

$t += ONE_MONTH;
say $t->ymd; #2012-04-03

$t += ONE_MONTH;
say $t->ymd; #2012-05-03

$t += ONE_MONTH * 2;
say $t->ymd; #2012-07-03

Time::Secondsを利用すると以下の定数が使えるようになります。
ONE_DAY
ONE_WEEK
ONE_HOUR
ONE_MINUTE
ONE_MONTH
ONE_YEAR
ONE_FINANCIAL_MONTH
LEAP_YEAR
NON_LEAP_YEAR

後は、掛け算して加減算するなりすればよいですね。