http://www.perlmonks.org?node_id=766094
Category: Utility Scripts
Author/Contact Info
Description: I use this script every day to create directories, have them organized, change between them and do not think to much about it.

I use it in a shell alias like this

alias cdheute='cd `mkdir_heute`'

Actually it used to be a module and the script but for simplicity and posting it here I have slurped the module into the script.

#!/usr/bin/perl -w
# vim: set sw=4 ts=4 tw=78 et si:
#
# mkdir_heute - choose or make a dir for 'heute' (today)
#
# This script scans a basedir (~/A) for directories named YYYY/MM/DD
# where YYYY, MM and DD are numbers corresponding to a year, month, da
+y of
# month and prints them on STDERR. You may choose a directory from the
+ list
# or a new directory which will be created and named after the current
+ day.
#
# The script returns the choosen directory on STDOUT and may be used i
+n a
# shell alias like this:
#
# alias cdheute='cd `mkdir_heute`'
#
# so that you may say 'cdheute' on the command line and your working d
+irectory
# will be changed to the choosen directory.
#
use strict; 
use warnings; 

use Term::ReadKey; 
package Directory::Organize;

use strict;
use warnings;
use version; our $VERSION = qv('0.8');

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) = @_;

    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 $m
+onth);
        $self->{tc}->{day}   = sprintf "%02d",$day      if (defined $d
+ay);
        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 sta
+rt
                                         \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/.pro
+ject)) {
                        $desc = <$PROJECT>;
                        close $PROJECT;
                        chomp $desc;
                    }
                    if ($self->{pattern} && $desc !~ /$self->{pattern}
+/i) {
                        next;
                    } 
                    push @{$self->{descriptions}}, [ $path, $desc ];
                }
            }
        }
    }
    return;
} # _read_descriptions();

1;

package main;

$|++;

my %params;

init_params(\%params);

print choosedir(\%params);

#----- only subs from now on -----

sub init_params {
    my ($params) = @_;

    my ($wchar, $hchar, $wpixels, $hpixels) = GetTerminalSize("STDOUT"
+);

    $params->{basedir} = "$ENV{HOME}/A";
    $params->{listlines} = defined $hchar ? $hchar - 4 : 21;

    return $params;
} # init_params()

sub makedir {
    my $path = shift;
    my $dir  = '';
    $path =~ s{^(.*[^/])$}{$1/}; # provide a sentinel
    while ($path =~ s{^([^/]*)/}{}) {
        if ($1) {
            $dir .= $1;
            (-d $dir) || mkdir($dir,0777) || return 0;
            $dir .= '/';
        }
        else {
            $dir = '/' unless ($dir);
        }
    }
    return 1;
} # makedir()

sub choosedir {
    my ($params)  = @_;

    my $basedir   = $params->{basedir};
    my $listlines = $params->{listlines};
    my $firstline = 0;

    my $do = Directory::Organize->new($basedir);

    NEW_DESCRIPTIONS:
    while (1) {
        my @directories = $do->get_descriptions();
        my $lastline  = scalar(@directories) - $listlines - 1;

        SHOW_DESCRIPTIONS:
        while (1) {
            show_dirs(\@directories,$listlines,$firstline);

        # let the user choose a directory
            my $input = '';
            while (1) {
                my $project_text = '';
                $input = <STDIN>;
                chomp $input;
                if ($input =~ /^\d+$/) {
                    return $basedir . '/' . $directories[$input]->[0]
                        if ($input < scalar @directories);
                }
                elsif ($input =~ /^f(irst)?$/i) {
                    $firstline = 0;
                    next SHOW_DESCRIPTIONS;
                }
                elsif ($input =~ /^l(ast)?$/i) {
                    $firstline = $lastline;
                    next SHOW_DESCRIPTIONS;
                }
                elsif ($input =~ /^n(ext)?$/i) {
                    $firstline += $listlines;
                    $firstline = $lastline if ($firstline > $lastline)
+;
                    next SHOW_DESCRIPTIONS;
                }
                elsif ($input =~ /^p(revious)?$/i) {
                    $firstline -= $listlines;
                    $firstline = 0 if ($firstline < 0);
                    next SHOW_DESCRIPTIONS;
                }
                elsif ($input =~ /^\/(.*)$/i) {
                    $do->set_pattern($1);
                    $firstline = 0;
                    next NEW_DESCRIPTIONS;
                }
                elsif ($input =~ m{^d
                                     \s*
                                     (?:
                                       ([=<>])      # operator
                                       \s*
                                       (\d{4})      # year
                                       -?
                                       (\d\d)?      # month
                                       -?
                                       (\d\d)?      # day
                                     )?
                                   }ix) {
                    $do->set_time_constraint($1,$2,$3,$4);
                    $firstline = 0;
                    next NEW_DESCRIPTIONS;
                }
                elsif ($input =~ /^(\.|q(uit)?)$/i) {
                    return '.';
                }
                elsif ($input =~ /^\+(.*)$/) {
                    if ($1) {
                        $project_text = $1;
                        $project_text =~ s/^\s+//;
                        $project_text =~ s/\s+$//;
                        return $do->new_dir($project_text);
                    }
                    next SHOW_DESCRIPTIONS;
                }
            }
        } # SHOW_DESCRIPTIONS
    } # NEW_DESCRIPTIONS
} # choosedir()

sub show_dirs {
    my ($dirs,$listlines,$firstline) = @_;
    my $i = 0;
    foreach my $dir (@$dirs) {
        printf STDERR "%-7s: %-12s: %s\n", $i, $dir->[0], $dir->[1]
            if ($i >= $firstline);
        last if ($i - $firstline >= $listlines);
        $i++;
    }
    print STDERR "+(plus): new directory (add description after '+')\n
+";
    print STDERR "q      : current directory\n";
} # show_dirs()

__END__

=head1 NAME

mkdir_heute - create and find directories interactive

=head1 VERSION

This documentation refers to Directory::Organize version 0.8

=head1 USAGE

This script scans a basedir (~/A) for directories named YYYY/MM/DD
where YYYY, MM and DD are numbers corresponding to a year, month, day 
+of
month and prints them on STDERR.

You may

=over 4

=item *

choose a directory from the list with it's number

=item *

choose the current directory with 'q' or '.'

=item *

advance to the next or last page with 'n' or 'l'

=item *

return to the previous or first page with 'p' or 'f'

=item *

constrain the shown directories with '/' and a pattern

=item *

constrain the creation date of the directories with 'd' followed by '=
+', '<'
or '>' and a date (eg. 2009, 2009-04 or 2009-04-24)

=item *

create a new directory with '+' and a description for it

=back

The script returns the choosen directory on STDOUT and may be used in 
+a
shell alias like this:

  alias cdheute='cd `mkdir_heute`'

so that you may say 'cdheute' on the command line and your working dir
+ectory
will be changed to the choosen directory.

=head1 AUTHOR

Mathias Weidner

=head1 LICENCE AND COPYRIGHT

Copyright (c) 2009 Mathias Weidner (mathias@weidner.in-bad-schmiedeber
+g.de).
All rights reserved.

This module is free software; you can redistribute and/or modify it
under the same terms as Perl itself. See L<perlartistic>.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.