Annotation of ConnorCalendar/calendar.pl, revision 1.3
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.3 ! nick 11: | $Id: calendar.pl,v 1.2 2013-05-28 22:07:14 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.3 ! nick 29: my $VERSION = qw/$Id$/;
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: "\"><--</a> <b>$YEAR</b> " .
78: "<a href=\"$URL?cy=" . ( $YEAR + 1 ) . "\">--></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>