#!/afs/athena/contrib/perl5/p -w

use FileHandle;
use strict;

use vars qw( $larg $arg $cal $head $mon $year @daylist );

$cal = new FileHandle;

$0 =~ s@.*/@@g;

$larg = pop(@ARGV) || die "Usage: $0 month [month ...] year\nQuitting";
@ARGV || die "Usage: $0 month [month ...] year\nQuitting";

for $arg (@ARGV) {
  open ($cal, "cal $arg $larg |");

  $head = <$cal>;
  $head =~ s/^\s+//;
  $head =~ s/\s+$//;

  ($mon, $year) = split(/\s+/, $head, 2);

  print STDERR "[$mon $year]\n";

  $head = <$cal>;		# junk

  while (($head = <$cal>) && ($head !~ /^\s*$/)) {
    push (@daylist, week($year, $mon, $head));
  }

  close($cal);
}

prdays(@daylist);

sub week {
  my ($y) = shift;
  my ($m) = shift;
  workweek(sprintf("%-3.3s%04d", "\L$m", $y), @_);
}

sub workweek {
  my ($tag, @lines) = @_;
  my ($l, @days);
  local ($_);

  for $l (@lines) {
    push(@days, unpack("A3" x 7, $l));
  }

  map { $_=~s/^\s+//; $_=~s/\s+$//; ($_? sprintf("%02d%s",$_,$tag):'') } @days;
}

sub prdays {
  my (@days) = squeeze(7, @_[1..$#_]);	# remove a sunday from first week
					# and remove "blank" weeks
  my ($frag, @week);

  $#days += 6 - ($#days % 7);		# pad array to multiple of 7 days
  @days = map { $_ } @days;		# (remap so 5.002 splice won't lose)

  while (@days) {
    @week = splice(@days, 0, 7);
    prweek(@week) if all_true(@week);
  }
}

sub squeeze {
  my ($sqwid, @data) = @_;
  my ($i) = 0;

  while ($i <= $#data) {	# this isn't foreach because $#data can change!
    if (all_false(@data[$i..($i+$sqwid-1)])) {
      splice @data, $i, 7;
    } else {
      $i++;
    }
  }
  @data;
}

sub all_true {
  local ($_);
  ! scalar(grep(! $_, @_));
}

sub all_false {
  local ($_);
  ! scalar(grep($_, @_));
}

sub prweek {
  my (@week) = @_;
  my (@wdays) = ('mon', 'tue', 'wed', 'thu', 'fri', 'sat', 'sun');

  while (@week) {
    printf "%s %s:  \n", shift(@week), shift(@wdays);
  }
  print "\n";
}