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を解いてみる。

1.

コード(TextWrangler)

#!/usr/bin/env perl
use strict;
use warnings;
use File::Find;
use Time::Local;

# 4は木曜日
my $target_dow = 4;
my @starting_directories = (".");

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;
  (sub {
    my $timestamp = (stat $_)[9];
    return unless defined $timestamp;
    push @files, $File::Find::name if $timestamp >= $start and
      $timestamp <= $stop;
  }
  , sub{
    @files;
  })
}

入出力結果(Terminal)

$ ./sample.pl
Thu Jul 19 17:06:53 2012: ./sample.pl
Thu Jul 19 17:06:53 2012: ./tmp_link
$