Perl - サブルーチンへのリファレンス(File::Findモジュール、無名サブルーチン)

続・初めてのPerl 改訂版
Randal L. Schwartz
brian d foy, Tom Phoenix 著

開発環境

• OS X Lion - Apple(OS)
• TextWrangler(Text Editor) (BBEditの機能制限無料版、light版)
• Script言語:Perl

『続・初めてのPerl 改訂版』(Randal L. Schwartz, brian d foy, Tom Phoenix 著、伊藤 直也、田中 慎司、吉川 英興 監訳、株式会社ロングテール/長尾 高弘 訳、オライリー・ジャパン、2006年、ISBN4-87311-305-9) の7章(サブルーチンへのリファレンス),　7.8(練習問題)1を解いてみる。

その他参考書籍

• プログラミングPerl〈VOLUME1〉
• プログラミングPerl〈VOLUME2〉
• Perlクックブック〈VOLUME1〉
• Perlクックブック〈VOLUME2〉

1.

コード(TextWrangler)

sample.pl

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use 5.016;
binmode STDOUT, ':utf8';
binmode STDIN, ':utf8';
use File::Find;
use Time::Local;

my $target_dow = 1;
my @starting_directories = qw(.);

my $seconds_per_day = 24*60*60;
my($sec, $min, $hour, $day, $mon, $yr, $dow) = localtime;
my $start = timelocal(0, 0, 0, $day, $mon, $yr);
while($dow != $target_dow){
  $start -= $seconds_per_day;
  $dow += 7 if --$dow < 0;
}
my $stop = $start + $seconds_per_day;

my($gather, $yield) = gather_mtime_between($start, $stop);
find($gather, @starting_directories);
my @files = $yield->();

for my $file (@files){
  my $mtime = (stat $file)[9];
  my $when = localtime $mtime;
  print "$when: $file\n";
}

sub gather_mtime_between{
  my($start, $stop) = @_;
  my @files;
  my $gather = sub{
    my $timestamp = (stat $_)[9];
    return unless defined $timestamp;
    push @files, $File::Find::name if $timestamp >= $start and $timestamp <= $stop;
  };
  my $yeild = sub {
    @files;
  };
  ($gather, $yeild);
}

入出力結果(Terminal)

$ ./perl/sample.pl
Mon Oct 22 09:58:13 2012: ./english 7
Mon Oct 22 18:53:33 2012: ./sql_kamimura_blog
Mon Oct 22 17:07:09 2012: ./ruby/ruby_kamimura_blog
Mon Oct 22 13:34:25 2012: ./Virtual Machines/Windows 7 x64.vmwarevm/Windows 7 x64.vmx.lck
Mon Oct 22 13:34:25 2012: ./Virtual Machines/Windows 7 x64.vmwarevm/Windows 7 x64.vmx.lck/M07798.lck
$