#!/usr/bin/perl -wT =begin comment info +------------------------------------------------------------------------------ | | See end of script for comments and 'pod2man $NAME | nroff -man' to | view man page or pod2text $NAME for plain text. | | Nicholas DeClario | March 2009 | $Id: calendar.pl,v 1.3 2013/05/28 22:58:31 nick Exp $ | +------------------------------------------------------------------------------ =end comment =cut BEGIN { delete @ENV{ qw(IFS CDPATH ENV BASH_ENV PATH) }; $ENV{'PATH'} = "/bin:/usr/bin"; } use strict; use Getopt::Long; use Pod::Usage; use Data::Dumper; use Calendar::Simple; use Date::Calendar::Year qw( :all ); use Date::Calendar::Profiles qw( $Profiles ); my $VERSION = qw/$Id: calendar.pl,v 1.3 2013/05/28 22:58:31 nick Exp $/; my $DEBUG = ""; my $URL = "http://demandred.dyndns.org/cgi-bin/ConnorCalendar/index.cgi"; my %post_in = ( ); my %opts = &fetchOptions( ); my @list = ( ); my @months = qw/ January February March April May June July August September October Novemeber December /; my %holidays = ( "Christmas Day" => 'even', "Christmas Eve" => 'odd', "Father's Day" => 'all', "Independence Day" => 'even', "Labor Day" => 'even', "Memorial Day" => 'odd', "New Year's Day" => 'even', "New Year's Eve" => 'odd', "Thanksgiving Day" => 'odd', ); my %specials = ( "11/28" => "even", "5/6" => "odd", ); my @weekend = qw/ 2011 8 12 /; my %weekends = &calcWeekends( @weekend ); &ReadParse( ); my $yr = sprintf( "%d", $post_in{'cy'} ) || ( ( localtime )[5] + 1900 ); my $YEAR = sprintf( "%d", $yr ); print "Content-type: text/html\n\n"; print ""; print "Calendar Days I Have Connor"; print "

Calendar for $YEAR

\n"; print "

Holidays I have Connor are in Red\n
"; print "Today is Blue\n
"; print "Weekends and special days I have Connor are in Green\n

"; my $year_us = Date::Calendar::Year->new( $YEAR, $Profiles->{'US-FL'} ); my @hdays = $year_us->labels( ); #$DEBUG = "Holidays for $YEAR:\n"; #foreach ( sort @hdays ) { $DEBUG .= $_ ."\n"; } print "
<-- $YEAR " . "-->
"; my $row = 0; print ""; for( my $month = 1; $month <= 12; $month++ ) { if ( $row >= 3 ) { $row = 0; print ""; } print ""; $row++; } print "
"; print "$months[($month - 1)]\n"; print "
Su Mo Tu We Th Fr Sa\n";
	my @CALS = calendar( $month, $YEAR );
	foreach my $cal ( @CALS ) 
	{
		foreach my $day ( @$cal ) 
		{
			if( defined $day ) 
			{
				my $h_day = ( $year_us->labels( $YEAR, $month, $day ) )[1];
				if( &IHaveConnor( $h_day ) ) {
					push @list, $h_day;
					print sprintf "%2d ", $day;
				} elsif ( &isSpecial( $YEAR, $month, $day ) || 
 					  &isWeekend( $YEAR, $month, $day ) ) {
					print sprintf "%2d ", $day;
				} elsif ( &isToday( $YEAR, $month, $day ) ) {
					print sprintf "%2d ", $day;
				} else {
					print sprintf "%2d ", $day;
				}
			} else {
				print '   ';
			}	
		}
		print "\n";
	}
	print "
"; print "
List of Special/Holidays I have Connor:
";
print map { $_ . "\n" } sort @list;
print "

Version: $VERSION
"; print "CVS: http://demandred.dyndns.org/cgi-bin/cvsweb/ConnorCalendar/"; print "
\n\n$DEBUG
"; ############################################################################### ############################################################################### sub IHaveConnor { my $holiday = shift || return 0; my $y = ( $YEAR % 2 ) ? "odd" : "even"; if ( defined $holidays{$holiday} ) { return 1 if ( $holidays{$holiday} eq "all" ); return 1 if ( $holidays{$holiday} eq $y ); } return 0; } sub isSpecial { my $y = shift || return 0; my $m = shift || return 0; my $d = shift || return 0; my $yr = ( $YEAR % 2 ) ? "odd" : "even"; my $ref = "$m/$d"; if ( defined $specials{$ref} ) { if ( $specials{$ref} eq "all" || $specials{$ref} eq $yr ) { push @list, $ref; return 1; } } return 0; } sub isWeekend { my $y = shift || return 0; my $m = shift || return 0; my $d = shift || return 0; $m--; my $ds = sprintf( "$y/$months[$m]/%02d", $d ); return 1 if ( defined $weekends{$ds} ); return 0; } sub isToday { my $y = shift || return 0; my $m = shift || return 0; my $d = shift || return 0; return 1 if ( $y eq ( ( localtime )[5] + 1900 ) && $m eq ( ( localtime )[4] + 1 ) && $d eq ( ( localtime )[3] ) ); return 0; } sub calcWeekends { my $y = shift; my $m = shift; my $d = shift; my %weekends = ( ); print "Weekends I have Connor:\n"; use Calendar; my $date = Calendar->new_from_Gregorian( $m, $d, $y ); $weekends{$date->date_string( "%Y/%M/%d" )} = 1; &twoMore( $date ); while ( $date->date_string( "%Y" ) <= 2026 ) { $date += 14; $weekends{$date->date_string( "%Y/%M/%d" )} = 1; &twoMore( $date ); } return %weekends; sub twoMore { my $td = shift; $td++; $weekends{$td->date_string( "%Y/%M/%d" )} = 1; $td++; $weekends{$td->date_string( "%Y/%M/%d" )} = 1; } } ############################################################################### ############################################################################### sub ReadParse { my $a = $_[0] ? $_[0] : \%post_in; my ( $i, $in ); my @in = ( ); if ( defined $ENV{'SERVER_NAME'} ) { my $SERVER = $ENV{'SERVER_NAME'}; } if ( ( defined $ENV{'REQUEST_METHOD'} ) && ($ENV{'REQUEST_METHOD'} eq 'POST') ) { read(STDIN, $in, $ENV{'CONTENT_LENGTH'}); } else { $in = $ENV{'QUERY_STRING'} || ""; } @in = split(/\&/, $in); foreach $i (@in) { my ($k, $v) = split(/=/, $i, 2); $k =~ s/\+/ /g; $k =~ s/%(..)/pack("c",hex($1))/ge; $v =~ s/\+/ /g; $v =~ s/%(..)/pack("c",hex($1))/ge; $a->{$k} = defined($a->{$k}) ? $a->{$k}."\0".$v : $v; } } ############################################################################### ## ## &fetchOptions( ); ## ## Grab our command line arguments and toss them in to a hash ## ############################################################################### sub fetchOptions { my %opts; &GetOptions( "help|?" => \$opts{'help'}, "man" => \$opts{'man'}, ) || &pod2usage( ); &pod2usage( ) if defined $opts{'help'}; &pod2usage( { -verbose => 2, -input => \*DATA } ) if defined $opts{'man'}; return %opts; } __END__ =head1 NAME masterbuild.pl - blurb =head1 SYNOPSIS masterbuild.pl [options] Options: --help,? Display the basic help menu --man,m Display the detailed man page =head1 DESCRIPTION =head1 HISTORY =head1 AUTHOR Nicholas DeClario =head1 BUGS This is a work in progress. Please report all bugs to the author. =head1 SEE ALSO =head1 COPYRIGHT =cut