#!/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.
|
