File:  [Local Repository] / ConnorCalendar / calendar.pl
Revision 1.4: download - view: text, annotated - select for diffs
Tue May 28 22:59:33 2013 UTC (10 years, 11 months ago) by nick
Branches: MAIN
CVS tags: first_release, HEAD
Fixed a typo in the $VERSION assignment... grumble

    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
   11: |	$Id: calendar.pl,v 1.4 2013/05/28 22:59:33 nick Exp $
   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: 
   29: my $VERSION  = q/$Id: calendar.pl,v 1.4 2013/05/28 22:59:33 nick Exp $/;
   30: my $DEBUG    = "";
   31: my $URL	     = "http://demandred.dyndns.org/cgi-bin/ConnorCalendar/index.cgi";
   32: my %post_in  = ( );
   33: my %opts     = &fetchOptions( );
   34: my @list     = ( );
   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: 		);
   53: my @weekend  = qw/ 2011 8 12 /;
   54: my %weekends = &calcWeekends( @weekend );
   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: 
   72: #$DEBUG = "Holidays for $YEAR:\n";
   73: #foreach ( sort @hdays ) { $DEBUG .= $_ ."\n"; }
   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 ) ) {
  100: 					push @list, $h_day;
  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>";
  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: 
  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: 	{
  154: 		if ( $specials{$ref} eq "all" ||
  155:    		     $specials{$ref} eq $yr ) {
  156: 			push @list, $ref;
  157: 			return 1;
  158: 		}
  159: 	}
  160: 
  161: 	return 0;
  162: }
  163: 
  164: sub isWeekend
  165: {
  166: 	my $y = shift || return 0;
  167:         my $m = shift || return 0;
  168:         my $d = shift || return 0;
  169: 
  170: 	$m--;
  171: 	my $ds = sprintf( "$y/$months[$m]/%02d", $d );
  172: 
  173: 	return 1 if ( defined $weekends{$ds} );
  174: 
  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: 
  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: 
  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>