Annotation of ConnorCalendar/calendar.pl, revision 1.4

1.1       nick        1: #!/usr/bin/perl -wT
                      2: 
                      3: =begin comment info
                      4: +------------------------------------------------------------------------------
                      5: |
                      6: | See end of script for comments and 'pod2man $NAME | nroff -man' to
                      7: | view man page or pod2text $NAME for plain text.
                      8: |
                      9: |   Nicholas DeClario <nick@demandred.dyndns.org>
                     10: |   March 2009
1.4     ! nick       11: |      $Id: calendar.pl,v 1.3 2013-05-28 22:58:31 nick Exp $
1.1       nick       12: |
                     13: +------------------------------------------------------------------------------
                     14: =end comment
                     15: =cut
                     16: BEGIN {
                     17:         delete @ENV{ qw(IFS CDPATH ENV BASH_ENV PATH) };
                     18:         $ENV{'PATH'} = "/bin:/usr/bin";
                     19:       }
                     20: 
                     21: use strict;
                     22: use Getopt::Long;
                     23: use Pod::Usage;
                     24: use Data::Dumper;
                     25: use Calendar::Simple;
                     26: use Date::Calendar::Year qw( :all );
                     27: use Date::Calendar::Profiles qw( $Profiles );
                     28: 
1.4     ! nick       29: my $VERSION  = q/$Id: calendar.pl,v 1.3 2013-05-28 22:58:31 nick Exp $/;
1.1       nick       30: my $DEBUG    = "";
1.2       nick       31: my $URL             = "http://demandred.dyndns.org/cgi-bin/ConnorCalendar/index.cgi";
1.1       nick       32: my %post_in  = ( );
                     33: my %opts     = &fetchOptions( );
1.3       nick       34: my @list     = ( );
1.1       nick       35: my @months   = qw/ January February March April May June July 
                     36:                   August September October Novemeber December /;
                     37: my %holidays = ( 
                     38:                 "Christmas Day"        => 'even',
                     39:                 "Christmas Eve"        => 'odd',
                     40:                 "Father's Day"         => 'all',
                     41:                 "Independence Day"     => 'even',
                     42:                 "Labor Day"            => 'even',
                     43:                 "Memorial Day"         => 'odd',
                     44:                 "New Year's Day"       => 'even',
                     45:                 "New Year's Eve"       => 'odd',
                     46:                 "Thanksgiving Day"     => 'odd', 
                     47:               );
                     48: 
                     49: my %specials = (
                     50:                "11/28"                 => "even",
                     51:                "5/6"                   => "odd",
                     52:                );
1.3       nick       53: my @weekend  = qw/ 2011 8 12 /;
                     54: my %weekends = &calcWeekends( @weekend );
1.1       nick       55: 
                     56: &ReadParse( );
                     57: 
                     58: my $yr =  sprintf( "%d", $post_in{'cy'} ) || ( ( localtime )[5] + 1900 );
                     59: my $YEAR = sprintf( "%d", $yr );
                     60: 
                     61: print "Content-type: text/html\n\n";
                     62: print "<html>";
                     63: print "<Title>Calendar Days I Have Connor</title>";
                     64: print "<h1>Calendar for $YEAR</h1>\n";
                     65: print "</p>Holidays I have Connor are in <font color=red>Red</font>\n</br>";
                     66: print "Today is <font color=blue>Blue</font>\n</br>";
                     67: print "Weekends and special days I have Connor are in <font color=green>Green</font>\n</p>";
                     68: 
                     69: my $year_us = Date::Calendar::Year->new( $YEAR, $Profiles->{'US-FL'} );
                     70: my @hdays = $year_us->labels( );
                     71: 
1.3       nick       72: #$DEBUG = "Holidays for $YEAR:\n";
                     73: #foreach ( sort @hdays ) { $DEBUG .= $_ ."\n"; }
1.1       nick       74: 
                     75: 
                     76: print "<center><a href=\"$URL?cy=" . ( $YEAR - 1 ) .
                     77:       "\">&lt;--</a> <b>$YEAR</b> " .
                     78:        "<a href=\"$URL?cy=" . ( $YEAR + 1 ) . "\">--&gt;</a></center>";
                     79: my $row = 0;
                     80: print "<table align=center border=1><tr>";
                     81: for( my $month = 1; $month <= 12; $month++ )
                     82: {
                     83:        if ( $row >= 3 ) 
                     84:        {
                     85:                $row = 0;
                     86:                print "</tr><tr>";
                     87:        }
                     88:        print "<td align=center valign=top>";
                     89:        print "<b>$months[($month - 1)]</b>\n";
                     90:        print "<pre>Su Mo Tu We Th Fr Sa\n";
                     91:        my @CALS = calendar( $month, $YEAR );
                     92:        foreach my $cal ( @CALS ) 
                     93:        {
                     94:                foreach my $day ( @$cal ) 
                     95:                {
                     96:                        if( defined $day ) 
                     97:                        {
                     98:                                my $h_day = ( $year_us->labels( $YEAR, $month, $day ) )[1];
                     99:                                if( &IHaveConnor( $h_day ) ) {
1.3       nick      100:                                        push @list, $h_day;
1.1       nick      101:                                        print sprintf "<font color=red><b>%2d</b> </font>", $day;
                    102:                                } elsif ( &isSpecial( $YEAR, $month, $day ) || 
                    103:                                          &isWeekend( $YEAR, $month, $day ) ) {
                    104:                                        print sprintf "<font color=green><b>%2d</b> </font>", $day;
                    105:                                } elsif ( &isToday( $YEAR, $month, $day ) ) {
                    106:                                        print sprintf "<font color=blue><b>%2d</b> </font>", $day;
                    107:                                } else {
                    108:                                        print sprintf "%2d ", $day;
                    109:                                }
                    110:                        } else {
                    111:                                print '   ';
                    112:                        }       
                    113:                }
                    114:                print "\n";
                    115:        }
                    116:        print "</pre></td>";
                    117:        $row++;
                    118: }
                    119: print "</tr></table>";
1.3       nick      120: print "<center>List of Special/Holidays I have Connor:<br /><pre>";
                    121: print map { $_ . "\n" } sort @list;
                    122: print "</pre><br /><hr />Version: <font color=green>$VERSION</font><br />";
                    123: print "CVS: <a href=\"http://demandred.dyndns.org/cgi-bin/cvsweb/ConnorCalendar/\">http://demandred.dyndns.org/cgi-bin/cvsweb/ConnorCalendar/</a>";
                    124: print "</center><pre>\n\n$DEBUG</pre>";
                    125: 
1.1       nick      126: 
                    127: ###############################################################################
                    128: ###############################################################################
                    129: sub IHaveConnor 
                    130: {
                    131:        my $holiday = shift || return 0;
                    132:        my $y = ( $YEAR % 2 ) ? "odd" : "even";
                    133: 
                    134:        if ( defined $holidays{$holiday} )
                    135:        {
                    136:                return 1 if ( $holidays{$holiday} eq "all" );
                    137:                return 1 if ( $holidays{$holiday} eq $y );
                    138:        }
                    139: 
                    140:        return 0;
                    141: }
                    142: 
                    143: sub isSpecial
                    144: {
                    145:         my $y = shift || return 0;
                    146:         my $m = shift || return 0;
                    147:         my $d = shift || return 0;
                    148:        my $yr = ( $YEAR % 2 ) ? "odd" : "even";
                    149: 
                    150:        my $ref = "$m/$d";
                    151:        
                    152:        if ( defined $specials{$ref} )
                    153:        {
1.3       nick      154:                if ( $specials{$ref} eq "all" ||
                    155:                     $specials{$ref} eq $yr ) {
                    156:                        push @list, $ref;
                    157:                        return 1;
                    158:                }
1.1       nick      159:        }
                    160: 
                    161:        return 0;
                    162: }
                    163: 
                    164: sub isWeekend
                    165: {
1.3       nick      166:        my $y = shift || return 0;
1.1       nick      167:         my $m = shift || return 0;
                    168:         my $d = shift || return 0;
                    169: 
1.3       nick      170:        $m--;
                    171:        my $ds = sprintf( "$y/$months[$m]/%02d", $d );
                    172: 
                    173:        return 1 if ( defined $weekends{$ds} );
                    174: 
1.1       nick      175:        return 0;
                    176: }
                    177: 
                    178: sub isToday
                    179: {
                    180:        my $y = shift || return 0;
                    181:        my $m = shift || return 0;
                    182:        my $d = shift || return 0;
                    183: 
                    184:        return 1 if ( $y eq ( ( localtime )[5] + 1900 ) &&
                    185:             $m eq ( ( localtime )[4] + 1 ) &&
                    186:             $d eq ( ( localtime )[3] ) );
                    187:        return 0;
                    188: }
                    189: 
1.3       nick      190: sub calcWeekends 
                    191: {
                    192:        my $y = shift;
                    193:        my $m = shift;
                    194:        my $d = shift;
                    195:        my %weekends = ( );
                    196: 
                    197:        print "Weekends I have Connor:\n";
                    198: 
                    199:        use Calendar;
                    200:        my $date = Calendar->new_from_Gregorian( $m, $d, $y );
                    201:                
                    202:        $weekends{$date->date_string( "%Y/%M/%d" )} = 1;
                    203:        &twoMore( $date );
                    204:        while ( $date->date_string( "%Y" ) <= 2026 ) 
                    205:        {
                    206:                $date += 14;
                    207:                $weekends{$date->date_string( "%Y/%M/%d" )} = 1;
                    208:                &twoMore( $date );
                    209:        }
                    210: 
                    211:        return %weekends;
                    212: 
                    213:        sub twoMore 
                    214:        {
                    215:                my $td = shift;
                    216:                
                    217:                $td++;
                    218:                $weekends{$td->date_string( "%Y/%M/%d" )} = 1;
                    219:                $td++;
                    220:                $weekends{$td->date_string( "%Y/%M/%d" )} = 1;
                    221:        }
                    222: }
                    223: 
1.1       nick      224: ###############################################################################
                    225: ###############################################################################
                    226: sub ReadParse
                    227: {
                    228:         my $a = $_[0] ? $_[0] : \%post_in;
                    229:         my ( $i, $in );
                    230:         my @in = ( );
                    231: 
                    232:         if ( defined $ENV{'SERVER_NAME'} ) {
                    233:                 my $SERVER = $ENV{'SERVER_NAME'};
                    234:         }
                    235: 
                    236:         if ( ( defined $ENV{'REQUEST_METHOD'} ) &&
                    237:              ($ENV{'REQUEST_METHOD'} eq 'POST') )
                    238:         {
                    239:                 read(STDIN, $in, $ENV{'CONTENT_LENGTH'});
                    240:         }
                    241:         else
                    242:         {
                    243:                 $in = $ENV{'QUERY_STRING'} || "";
                    244:         }
                    245: 
                    246:         @in = split(/\&/, $in);
                    247: 
                    248:         foreach $i (@in)
                    249:         {
                    250:                 my ($k, $v) = split(/=/, $i, 2);
                    251:                 $k =~ s/\+/ /g; $k =~ s/%(..)/pack("c",hex($1))/ge;
                    252:                 $v =~ s/\+/ /g; $v =~ s/%(..)/pack("c",hex($1))/ge;
                    253:                 $a->{$k} = defined($a->{$k}) ? $a->{$k}."\0".$v : $v;
                    254:         }
                    255: 
                    256: }
                    257: 
                    258: ###############################################################################
                    259: ##
                    260: ## &fetchOptions( );
                    261: ##
                    262: ##      Grab our command line arguments and toss them in to a hash
                    263: ##
                    264: ###############################################################################
                    265: sub fetchOptions {
                    266:         my %opts;
                    267: 
                    268:         &GetOptions(
                    269:                         "help|?"        => \$opts{'help'},
                    270:                         "man"           => \$opts{'man'},
                    271:                    ) || &pod2usage( );
                    272:         &pod2usage( ) if defined $opts{'help'};
                    273:         &pod2usage( { -verbose => 2, -input => \*DATA } ) if defined $opts{'man'};
                    274: 
                    275:         return %opts;
                    276: }
                    277: 
                    278: __END__
                    279: 
                    280: =head1 NAME
                    281: 
                    282: masterbuild.pl - blurb
                    283: 
                    284: =head1 SYNOPSIS
                    285: 
                    286: masterbuild.pl [options]
                    287: 
                    288:  Options:
                    289:         --help,?        Display the basic help menu
                    290:         --man,m         Display the detailed man page
                    291: 
                    292: =head1 DESCRIPTION
                    293: 
                    294: =head1 HISTORY
                    295: 
                    296: =head1 AUTHOR
                    297: 
                    298: Nicholas DeClario <nick@declario.com>
                    299: 
                    300: =head1 BUGS
                    301: 
                    302: This is a work in progress.  Please report all bugs to the author.
                    303: 
                    304: =head1 SEE ALSO
                    305: 
                    306: =head1 COPYRIGHT
                    307: 
                    308: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>