#! /usr/bin/perl -w

# (C) Copyright 2003 Rahul Dhesi, All rights reserved.
#
# "As is" -- No warranty.
#
# Copying, use, and modification are permitted, governed by
# the GNU General Public License, by only those who agree
# to use this program at their own risk.

use strict;

# $Source: /mi/maincvs/linux/lowcal,v $
# $Id: lowcal,v 1.1 2003/02/06 09:43:05 dhesi Exp $
#
# Make 'cal' more friendly
#
# Tested on:
#  SunOS 4.1.3
#  FreeBSD 3.5-STABLE
#  RedHat Linux 7.2.

$::myname = $0;
$::myname =~ s|.*/||;

$::RCSHEADER = '$Source: /mi/maincvs/linux/lowcal,v $' . "\n" .
	'$Id: lowcal,v 1.1 2003/02/06 09:43:05 dhesi Exp $';

# suppresss perl warnings
$::debug = $::trace = $::verbose = $::opt_h = undef;
$::opt_v = $::opt_t = $::opt_x = undef;

$::usage = "usage: $::myname [-vtx] arg ... (or -h for help)";
if (@ARGV && $ARGV[0] =~ "^-.+" ) {
   require "getopts.pl";
   &Getopts("vtxhZ");
}

$::debug = $::opt_x;
$::trace = $::opt_t;
$::verbose = $::debug || $::trace || $::opt_v;
if ($::opt_h) {
   &givehelp();
   exit(0);
}

# program goes here
if (! @ARGV) {
   system 'cal';
   exit;
}

abbrev(*abtab, 
   qw(january february march april may june july 
   august september october november december));

if ($::debug) {
   my($key, $val);
   for $key (keys %::abtab) {
      print "> abtab\{$key\} = $::abtab{$key}\n";
   }
}

# collect and parse args
my $arg;
my $year;
my @months;

for $arg (@ARGV) {
   if ($arg =~ /^\d\d\d\d$/) {		# 4-digit year
      if (defined($year) && $year ne $arg) {
	 die "$::myname: error: conflicting years: $year and $arg\n";
      }
      $year = $arg;
   } elsif ($arg =~ /^\d\d$/) {
      if ($arg < 70) {			# xx < 70 means 20xx
	 $arg += 2000;
      } else {
	 $arg += 1900;
      }
      if (defined($year) && $year ne $arg) {
	 die "$::myname: error: conflicting years: $year and $arg\n";
      }
      $year = $arg;
   } else {
      if (defined($::abtab{$arg})) {
	 $arg = $::abtab{$arg};
	 $::debug && print "> month = $arg\n";
	 if ($arg =~ /^january$/i) {
	    push(@months, 1);
	 } elsif ($arg =~ /^february$/i) {
	    push(@months, 2);
	 } elsif ($arg =~ /^march$/i) {
	    push(@months, 3);
	 } elsif ($arg =~ /^april$/i) {
	    push(@months, 4);
	 } elsif ($arg =~ /^may$/i) {
	    push(@months, 5);
	 } elsif ($arg =~ /^june$/i) {
	    push(@months, 6);
	 } elsif ($arg =~ /^july$/i) {
	    push(@months, 7);
	 } elsif ($arg =~ /^august$/i) {
	    push(@months, 8);
	 } elsif ($arg =~ /^september$/i) {
	    push(@months, 9);
	 } elsif ($arg =~ /^october$/i) {
	    push(@months, 10);
	 } elsif ($arg =~ /^november$/i) {
	    push(@months, 11);
	 } elsif ($arg =~ /^december$/i) {
	    push(@months, 12);
	 }
      } else {
	 die "$::myname: $arg: invalid argument\n";
      }
   }
}

if (@months) {
   # if months specified, must also specify year
   if (! defined($year)) {
      $year = (localtime)[5] + 1900;
      $::debug && print "> year = $year\n";
   }
   my $month;
   for $month (@months) {
      system "cal $month $year";
   }
} else {
   system "cal $year\n";
};


sub usage_error {
   my($msg) = @_;
   if ($msg) {
      die "$msg\n";
   } else {
      die "$::usage\n";
   }
}

sub givehelp {
   ## require 'local/page.pl';
   ## &page(<<EOF);
   print <<EOF;
$::usage

Invokes 'cal' in a friendly way.  Takes as arguments one or more month
names (which can be arbitrarily abbreviated) and/or a four-digit year.

   jan                  - print january current year
   jan 1998             - print january 1998
   1998 jan             - print january 1998
   jan feb mar          - print january, february, march
   1998 jan feb mar     - print january, february, march 1998
   1998 		- print entire year 1998
   janu			- print january
   januar		- print january
   january		- print january

$::RCSHEADER
EOF
}

# Make table of abbreviations for all months
# (adapted from Text::Abbrev module)
sub abbrev {
    no strict;
    package abbrev;
    local(*domain) = shift;

    foreach $name (@_) {
        @extra = split(//,$name);
        $abbrev = shift(@extra);
        $len = 1;
        foreach $cmp (@cmp) {
            next if $cmp eq $name;
            while (substr($cmp,0,$len) eq $abbrev) {
                $abbrev .= shift(@extra);
                ++$len;
            }
        }
        $domain{$abbrev} = $name;
        while (@extra) {
            $abbrev .= shift(@extra);
            $domain{$abbrev} = $name;
	    $::debug && print "$abbrev -> $name\n";
        }
    }
}