#!/usr/bin/perl
#<mkyear: program using simple options plus script metadata.

#<mkyear: read "cal" output for a given year, write preformatted result.

use Getopt::Long qw(GetOptions);
use File::Basename;
use Carp;
use strict;
use warnings;

use subs qw(myuuid susage version where);
local $ENV{'PATH'} = join ":", qw(/bin /usr/bin /usr/local/bin);

my %meta;
my $myname = basename($0);
$myname =~ s/\.\w*$//x;  # strip any extension

# Command-line options.
my %options;
my @getopt_args = (
    'b',      # print document body only
    'h|?',    # print usage
    'u',      # print UUID
    'v',      # print version
    'w',      # print source location
    );

Getopt::Long::config("noignorecase", "bundling");
susage unless GetOptions(\%options, @getopt_args);

myuuid  if $options{'u'};
version if $options{'v'};
where   if $options{'w'};
susage  if $options{'h'};

my $year;
my ($gutter, $mon1, $mon2, $mon3);
my $month;
my $start;
my $str;
my $url;

# Read until year.  There's an unneeded blank line after the year.
while (<>) {
    chomp;
    if (/^\s\s*(\d\d\d\d)\s*$/) {
        $year = $1;
        $_ = <>;
        last;
    }
}

# Write optional header, start of body.
print <<EndHeader unless $options{'b'};
<!DOCTYPE html>
<html>
<head>
  <title>$year calendar</title>
  <link rel="stylesheet" href="calendar.css" type="text/css" media="screen">
</head>
<body>
EndHeader

print <<StartBody;
<!-- Generated by $myname using "cal $year" -->
  <pre class="calendar">
StartBody

# Read dates.  Months should be spaced like this to make additional
# processing easier: one leading space, then a block of 20 characters for
# each month with 4 spaces between each month.  This makes it easier
# to split and format the dates for each line.
#
#   ....+....1....+....2....+....3....+....4....+....5....+....6....+....7
#           January                February                  March
#    Su Mo Tu We Th Fr Sa    Su Mo Tu We Th Fr Sa    Su Mo Tu We Th Fr Sa
#   ....+....1....+....2....+....3....+....4....+....5....+....6....+....7

$gutter = '    ';    # 4 spaces
while (<>) {
    chomp;
    next if length() == 0;

    $mon1 = substr($_, 0, 20);
    $mon2 = substr($_, 23, 20);
    $mon3 = substr($_, 46, 20);
    $_  = ' ' . $mon1 . $gutter;
    $_ .= $mon2 . $gutter if defined($mon2);
    $_ .= $mon3           if defined($mon3);

    # Now we can split the line up a little more easily.
    # Month or day name:
    #
    if (/[A-Z]/) {
        if    (/Jan/) { print "$_\n";   $start = 1; }
        elsif (/Apr/) { print "\n$_\n"; $start = 4; }
        elsif (/Jul/) { print "\n$_\n"; $start = 7; }
        elsif (/Oct/) { print "\n$_\n"; $start = 10; }
        elsif (/Sa/)  { s/Sa/Sa /g;     print "$_\n"; }
    }

    # Split every line with weekdays into three-column chunks.  The ones
    # ending with a digit are dates to be turned into links.
    #
    elsif (/[0-9]/) {
        # first month: unpack turns an all-space entry into a
        # zero-length array entry.  Anything else comes out as a
        # number with one or more leading spaces.
        $month = $start;
        $str = substr($_, 0, 21);        # print "[$str]\n";
        dofmt($str, $month, $gutter);

        # second month.
        $month = $start + 1;
        $str = substr($_, 24, 21);       #  print "[$str]\n";
        dofmt($str, $month, $gutter);

        # third month.
        $month = $start + 2;
        $str = substr($_, 48, 21);       #  print "[$str]\n";
        dofmt($str, $month, '');

        # Done with this line
        print "\n";
    }
}

# Footer.
print "</pre>\n";
print "</body></html>\n" unless $options{'b'};
exit(0);

#---------------------------------------------------------------------
# Print a short usage message and exit.

sub susage {
    my ($emsg) = @_;
    warn "$emsg\n" if defined $emsg;

    print <<"EndHelp";
$myname reads "cal" output for a given year, writes preformatted
HTML template.

Options:
    -h prints this message and exits
    -b prints the HTML body only, no CSS
    -u prints the UUID and exits
    -v prints the version and exits
    -w prints the source location and exits

Example:
    cal 2010 | $myname > 2010.tpl

EndHelp
    exit(1);
}

#---------------------------------------------------------------------
# Print the UUID, current version, or source location.
# Store version info, etc. so we can use it in more than one place.
# The "use version..." line is for CPAN compatibility.

BEGIN {
    no warnings 'qw'; ## no critic (TestingAndDebugging::ProhibitNoWarnings)
    use version; our $VERSION = qv((qw$Revision: 2.3 $)[-1]);

    %meta = (
        'date'    => join(" ", (qw$Date: 2019-01-14 20:23:45-05 $)[-2, -1]),
        'host'    => (qw$Host: zhtv-82326 $)[-1],
        'source'  => (qw$Source: /doc/html/calendar/templates-3-month.pre/RCS/mkyear,v $)[-1],
        'uuid'    => (qw$UUID: b790e266-9bbb-4ae1-b4b0-1eb57e7bbda0 $)[-1],
        'version' => $VERSION
        );
}

sub myuuid  { print "$meta{'uuid'}\n"; exit(0); }
sub version { print "$myname $meta{'version'} $meta{'date'}\n"; exit(0); }
sub where   { print "file://$meta{'host'}", "$meta{'source'}\n"; exit(0); }

# -----------------------------------------------------------------
# Accept a week's worth of dates and print them correctly.
# Wanted: date turned into an accurate link plus a visible
# number with the right amount of spacing.

sub dofmt {
    my ($str, $mon, $spaces) = @_;
    my @days = unpack('A3' x 7, $str);

    foreach my $d (@days) {
        if (length($d)) {
            $url = sprintf("%2.2d%2.2d", $mon, $d);
            print "<a href=\"$url\">$d</a>";
        }
        else {
            print "   ";
        }
    }

    # At the end of each week, we may need a gutter.
    print "$spaces";
}

__END__
This is what the cal output for a given year should look like:

 ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+
        January                February                  March
 Su Mo Tu We Th Fr Sa    Su Mo Tu We Th Fr Sa    Su Mo Tu We Th Fr Sa
 ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+
        1  2  3  4  5                    1  2                    1  2
  6  7  8  9 10 11 12     3  4  5  6  7  8  9     3  4  5  6  7  8  9
 13 14 15 16 17 18 19    10 11 12 13 14 15 16    10 11 12 13 14 15 16
 20 21 22 23 24 25 26    17 18 19 20 21 22 23    17 18 19 20 21 22 23
 27 28 29 30 31          24 25 26 27 28          24 25 26 27 28 29 30
                                                 31
         April                    May                    June
 Su Mo Tu We Th Fr Sa    Su Mo Tu We Th Fr Sa    Su Mo Tu We Th Fr Sa
     1  2  3  4  5  6              1  2  3  4                       1
  7  8  9 10 11 12 13     5  6  7  8  9 10 11     2  3  4  5  6  7  8
 14 15 16 17 18 19 20    12 13 14 15 16 17 18     9 10 11 12 13 14 15
 21 22 23 24 25 26 27    19 20 21 22 23 24 25    16 17 18 19 20 21 22
 28 29 30                26 27 28 29 30 31       23 24 25 26 27 28 29
                                                 30
         July                   August                 September
 Su Mo Tu We Th Fr Sa    Su Mo Tu We Th Fr Sa    Su Mo Tu We Th Fr Sa
     1  2  3  4  5  6                 1  2  3     1  2  3  4  5  6  7
  7  8  9 10 11 12 13     4  5  6  7  8  9 10     8  9 10 11 12 13 14
 14 15 16 17 18 19 20    11 12 13 14 15 16 17    15 16 17 18 19 20 21
 21 22 23 24 25 26 27    18 19 20 21 22 23 24    22 23 24 25 26 27 28
 28 29 30 31             25 26 27 28 29 30 31    29 30
 
        October                November                December
 Su Mo Tu We Th Fr Sa    Su Mo Tu We Th Fr Sa    Su Mo Tu We Th Fr Sa
        1  2  3  4  5                    1  2     1  2  3  4  5  6  7
  6  7  8  9 10 11 12     3  4  5  6  7  8  9     8  9 10 11 12 13 14
 13 14 15 16 17 18 19    10 11 12 13 14 15 16    15 16 17 18 19 20 21
 20 21 22 23 24 25 26    17 18 19 20 21 22 23    22 23 24 25 26 27 28
 27 28 29 30 31          24 25 26 27 28 29 30    29 30 31
