File Coverage

blib/lib/Directory/Organize.pm

Criterion	Covered	Total	%
statement	136	149	91.2
branch	57	78	73.0
condition	22	36	61.1
subroutine	11	11	100.0
pod	6	6	100.0
total	232	280	82.8

# vim: set ts=4 sw=4 tw=78 et si:

package Directory::Organize;

use strict;
use warnings;
use version; our $VERSION = qv('v1.0.1');

sub new {
    my $self = shift;
    my $type = ref($self) || $self;

    $self = bless {}, $type;
    $self->{basedir} = shift;
    $self->set_today();

    return $self;
} # new();

sub get_descriptions {
    my $self = shift;

    if (!exists $self->{descriptions}) {
        $self->_read_descriptions();
    }
    return wantarray ? @{$self->{descriptions}} : $self->{descriptions};
} # get_descriptions()

sub new_dir {
    my ($self,$descr) = @_;
    my $daydir = sprintf "%4.4d/%2.2d/%2.2d", $self->{tyear}, $self->{tmonth}
                                            , $self->{tday};
    my $dirprefix = qq($self->{basedir}/$daydir);
    my $suffix = q();
    if (-d $dirprefix) {
        $suffix = 'a';
        while (-d qq($dirprefix$suffix)) {
            $suffix++;
        }
    }
    my $path = qq($dirprefix$suffix/);
    my $dir = q();
    while ($path =~ s{^([^/]*)/}{}) {
        if ($1) {
            $dir .= $1;
            (-d $dir) || mkdir($dir,0777) || return undef;
            $dir .= '/';
        }
        else {
            $dir = '/' unless ($dir);
        }
    }
    my $project = qq($dirprefix$suffix/.project);
    if ($descr and open (my $PROJ,'>',$project)) {
        print $PROJ qq($descr\n);
        close $PROJ;
    }
    return qq($dirprefix$suffix);
} # new_dir()

sub set_pattern {
    my ($self,$pattern) = @_;

    # do nothing with unchanged pattern
    if ($pattern
        && defined $self->{pattern}
        && $self->{pattern} eq $pattern) {
        return;
    }
    if (!$pattern and !defined $self->{pattern}) {
        return;
    }
    delete $self->{descriptions};
    if (!$pattern) {
        delete $self->{pattern};
    }
    else {
        $self->{pattern} = $pattern;
    }
} # set_pattern()

sub set_time_constraint {
    my ($self,$op,$year,$month,$day) = @_;
    if (defined $year and $op =~ /^[=<>]$/) {
        $self->{tc}->{op}    = $op;
        $self->{tc}->{year}  = sprintf "%04d",$year;
        $self->{tc}->{month} = sprintf "%02d",$month    if (defined $month);
        $self->{tc}->{day}   = sprintf "%02d",$day      if (defined $day);
        delete $self->{descriptions};
    }
    else {
        if ($self->{tc}) {
            delete $self->{descriptions};
            delete $self->{tc};
        }
    }
} # set_time_constraint()

sub set_today {
    my $self = shift;
    my ($tday,$tmonth,$tyear) = @_;
    if (defined $tyear) {
        $self->{tday}   = $tday;
        $self->{tmonth} = $tmonth;
        $self->{tyear}  = $tyear;
        return;
    }
    my ($day,$month,$year) = (localtime)[3,4,5];
    $year  += 1900;
    $month += 1;
    if (defined $tmonth) {
        $self->{tday}   = $tday;
        $self->{tmonth} = $tmonth;
        $self->{tyear}  = $year;
    }
    elsif (defined $tday) {
        $self->{tday}   = $tday;
        $self->{tmonth} = $month;
        $self->{tyear}  = $year;
    }
    else {
        $self->{tday}   = $day;
        $self->{tmonth} = $month;
        $self->{tyear}  = $year;
    }
    return;
} # set_today()

sub _not_in_tc {
    my ($self,$year,$month,$day) = @_;
    my ($tc,$tc_date,$date,$result);

    $tc = $self->{tc};

    if (defined $day) {
        if (defined $tc->{day}) {
            $tc_date = $tc->{year} . $tc->{month} . $tc->{day};
            $date    = $year . $month . substr($day,0,2);
        }
        elsif (defined $tc->{month}) {
            $tc_date = $tc->{year} . $tc->{month};
            $date    = $year . $month;
        }
        else {
            $tc_date = $tc->{year};
            $date    = $year;
        }
    }
    elsif (defined $month) {
        if (defined $tc->{day}) {
            $tc_date = $tc->{year} . $tc->{month};
            $date    = $year . $month;
            $date++ if ('>' eq $tc->{op});
            $date-- if ('<' eq $tc->{op});
        }
        elsif (defined $tc->{month}) {
            $tc_date = $tc->{year} . $tc->{month};
            $date    = $year . $month;
        }
        else {
            $tc_date = $tc->{year};
            $date    = $year;
        }
    }
    else {
        if (defined $tc->{month}) {
            $tc_date = $tc->{year};
            $date    = $year;
            $date++ if ('>' eq $tc->{op});
            $date-- if ('<' eq $tc->{op});
        }
        else {
            $tc_date = $tc->{year};
            $date    = $year;
        }
    }
    $result = '<' eq $tc->{op} ? $date ge $tc_date
            : '>' eq $tc->{op} ? $date le $tc_date
            :                    $date ne $tc_date
            ;
    return $result;
} # _not_in_tc()

sub _read_descriptions {
    my $self = shift;
    my $base = $self->{basedir};
    $self->{descriptions} = [];

    if (opendir my $BASEDIR, $base) {

        my %dirs = map  { ("$_" => {}) }
                   grep { m/^       # match names with
                            \d{4}   # four digits
                            $       # exactly
                           /x }
                   readdir( $BASEDIR );
        closedir $BASEDIR;

        YEAR:
        for my $year (reverse sort keys %dirs) {
            next if ($self->{tc} && $self->_not_in_tc($year));
            if (opendir my $YEARDIR, qq($base/$year)) {
                my %mdirs = map  { ("$_" => {}) }
                            grep { m/^      # match names with
                                     \d{2}  # two digits
                                     $      # exactly
                                    /x }
                            readdir( $YEARDIR );
                $dirs{$year} = \%mdirs;
                closedir $YEARDIR;
            }

            MONTH:
            for my $month (reverse sort keys %{$dirs{$year}}) {
                next if ($self->{tc} && $self->_not_in_tc($year,$month));
                if (opendir my $MONTHDIR, qq($base/$year/$month)) {
                    my %ddirs = map  { ("$_" => {}) }
                                grep { m/^      # match names that start
                                         \d{2}  # with two digits
                                        /x
                                     && -d qq($base/$year/$month/$_) }
                                readdir($MONTHDIR);
                    $dirs{$year}->{$month} = \%ddirs;
                    close $MONTHDIR;
                }

                DAY:
                for my $day (reverse sort keys %{$dirs{$year}->{$month}}) {
                    next if ($self->{tc}
                            && $self->_not_in_tc($year,$month,$day));
                    my $path = qq($year/$month/$day);
                    my $desc = "";
                    if (-f qq($base/$path/.project)
                        and open my $PROJECT, '<', qq($base/$path/.project)) {
                        $desc = <$PROJECT>;
                        close $PROJECT;
                        chomp $desc;
                    }
                    if ($self->{pattern} && $desc !~ /$self->{pattern}/i) {
                        next;
                    }
                    push @{$self->{descriptions}}, [ $path, $desc ];
                }
            }
        }
    }
    return;
} # _read_descriptions();

1;

__END__