Perl - サブルーチンへのリファレンス(無名サブルーチン、コールバック)

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

開発環境

• OS X Lion - Apple(OS)
• BBEdit - Bare Bones Software, Inc., Emacs(Text Editor)
• プログラミング言語: 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.

コード(BBEdit)

sample.pl

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

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

my $target_dow = 1;
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;
    if (--$dow < 0) {
        $dow += 7;
    }
}
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";
}

入出力結果(Terminal)

$ ./sample.pl
symlink.txt: Too many levels of symbolic links
Mon Sep  9 12:22:10 2013: ./__pycache__
Mon Sep  9 12:22:10 2013: ./__pycache__/sample.cpython-33.pyc
$