Annotation of ConnorCalendar/calendar.pl, revision 1.2
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.2 ! nick 11: | $Id: calendar.pl,v 1.1.1.1 2013-05-28 21:56:57 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:
29: my $DEBUG = "";
1.2 ! nick 30: my $URL = "http://demandred.dyndns.org/cgi-bin/ConnorCalendar/index.cgi";
1.1 nick 31: my %post_in = ( );
32: my %opts = &fetchOptions( );
33: my @months = qw/ January February March April May June July
34: August September October Novemeber December /;
35: my %holidays = (
36: "Christmas Day" => 'even',
37: "Christmas Eve" => 'odd',
38: "Father's Day" => 'all',
39: "Independence Day" => 'even',
40: "Labor Day" => 'even',
41: "Memorial Day" => 'odd',
42: "New Year's Day" => 'even',
43: "New Year's Eve" => 'odd',
44: "Thanksgiving Day" => 'odd',
45: );
46:
47: my %specials = (
48: "11/28" => "even",
49: "5/6" => "odd",
50: );
51:
52: &ReadParse( );
53:
54: my $yr = sprintf( "%d", $post_in{'cy'} ) || ( ( localtime )[5] + 1900 );
55: my $YEAR = sprintf( "%d", $yr );
56:
57: print "Content-type: text/html\n\n";
58: print "<html>";
59: print "<Title>Calendar Days I Have Connor</title>";
60: print "<h1>Calendar for $YEAR</h1>\n";
61: print "</p>Holidays I have Connor are in <font color=red>Red</font>\n</br>";
62: print "Today is <font color=blue>Blue</font>\n</br>";
63: print "Weekends and special days I have Connor are in <font color=green>Green</font>\n</p>";
64:
65: my $year_us = Date::Calendar::Year->new( $YEAR, $Profiles->{'US-FL'} );
66: my @hdays = $year_us->labels( );
67:
68: $DEBUG = "Holidays for $YEAR:\n";
69: foreach ( sort @hdays ) { $DEBUG .= $_ ."\n"; }
70:
71:
72: print "<center><a href=\"$URL?cy=" . ( $YEAR - 1 ) .
73: "\"><--</a> <b>$YEAR</b> " .
74: "<a href=\"$URL?cy=" . ( $YEAR + 1 ) . "\">--></a></center>";
75: my $row = 0;
76: print "<table align=center border=1><tr>";
77: for( my $month = 1; $month <= 12; $month++ )
78: {
79: if ( $row >= 3 )
80: {
81: $row = 0;
82: print "</tr><tr>";
83: }
84: print "<td align=center valign=top>";
85: print "<b>$months[($month - 1)]</b>\n";
86: print "<pre>Su Mo Tu We Th Fr Sa\n";
87: my @CALS = calendar( $month, $YEAR );
88: foreach my $cal ( @CALS )
89: {
90: foreach my $day ( @$cal )
91: {
92: if( defined $day )
93: {
94: my $h_day = ( $year_us->labels( $YEAR, $month, $day ) )[1];
95: if( &IHaveConnor( $h_day ) ) {
96: print sprintf "<font color=red><b>%2d</b> </font>", $day;
97: } elsif ( &isSpecial( $YEAR, $month, $day ) ||
98: &isWeekend( $YEAR, $month, $day ) ) {
99: print sprintf "<font color=green><b>%2d</b> </font>", $day;
100: } elsif ( &isToday( $YEAR, $month, $day ) ) {
101: print sprintf "<font color=blue><b>%2d</b> </font>", $day;
102: } else {
103: print sprintf "%2d ", $day;
104: }
105: } else {
106: print ' ';
107: }
108: }
109: print "\n";
110: }
111: print "</pre></td>";
112: $row++;
113: }
114: print "</tr></table>";
115: print "<pre>$DEBUG</pre>";
116:
117: ###############################################################################
118: ###############################################################################
119: sub IHaveConnor
120: {
121: my $holiday = shift || return 0;
122: my $y = ( $YEAR % 2 ) ? "odd" : "even";
123:
124: if ( defined $holidays{$holiday} )
125: {
126: return 1 if ( $holidays{$holiday} eq "all" );
127: return 1 if ( $holidays{$holiday} eq $y );
128: }
129:
130: return 0;
131: }
132:
133: sub isSpecial
134: {
135: my $y = shift || return 0;
136: my $m = shift || return 0;
137: my $d = shift || return 0;
138: my $yr = ( $YEAR % 2 ) ? "odd" : "even";
139:
140: my $ref = "$m/$d";
141:
142: if ( defined $specials{$ref} )
143: {
144: return 1 if ( $specials{$ref} eq "all" ||
145: $specials{$ref} eq $yr );
146: }
147:
148: return 0;
149: }
150:
151: sub isWeekend
152: {
153: my $y = shift || return 0;
154: my $m = shift || return 0;
155: my $d = shift || return 0;
156:
157: return 0;
158: }
159:
160: sub isToday
161: {
162: my $y = shift || return 0;
163: my $m = shift || return 0;
164: my $d = shift || return 0;
165:
166: return 1 if ( $y eq ( ( localtime )[5] + 1900 ) &&
167: $m eq ( ( localtime )[4] + 1 ) &&
168: $d eq ( ( localtime )[3] ) );
169: return 0;
170: }
171:
172: ###############################################################################
173: ###############################################################################
174: sub ReadParse
175: {
176: my $a = $_[0] ? $_[0] : \%post_in;
177: my ( $i, $in );
178: my @in = ( );
179:
180: if ( defined $ENV{'SERVER_NAME'} ) {
181: my $SERVER = $ENV{'SERVER_NAME'};
182: }
183:
184: if ( ( defined $ENV{'REQUEST_METHOD'} ) &&
185: ($ENV{'REQUEST_METHOD'} eq 'POST') )
186: {
187: read(STDIN, $in, $ENV{'CONTENT_LENGTH'});
188: }
189: else
190: {
191: $in = $ENV{'QUERY_STRING'} || "";
192: }
193:
194: @in = split(/\&/, $in);
195:
196: foreach $i (@in)
197: {
198: my ($k, $v) = split(/=/, $i, 2);
199: $k =~ s/\+/ /g; $k =~ s/%(..)/pack("c",hex($1))/ge;
200: $v =~ s/\+/ /g; $v =~ s/%(..)/pack("c",hex($1))/ge;
201: $a->{$k} = defined($a->{$k}) ? $a->{$k}."\0".$v : $v;
202: }
203:
204: }
205:
206: ###############################################################################
207: ##
208: ## &fetchOptions( );
209: ##
210: ## Grab our command line arguments and toss them in to a hash
211: ##
212: ###############################################################################
213: sub fetchOptions {
214: my %opts;
215:
216: &GetOptions(
217: "help|?" => \$opts{'help'},
218: "man" => \$opts{'man'},
219: ) || &pod2usage( );
220: &pod2usage( ) if defined $opts{'help'};
221: &pod2usage( { -verbose => 2, -input => \*DATA } ) if defined $opts{'man'};
222:
223: return %opts;
224: }
225:
226: __END__
227:
228: =head1 NAME
229:
230: masterbuild.pl - blurb
231:
232: =head1 SYNOPSIS
233:
234: masterbuild.pl [options]
235:
236: Options:
237: --help,? Display the basic help menu
238: --man,m Display the detailed man page
239:
240: =head1 DESCRIPTION
241:
242: =head1 HISTORY
243:
244: =head1 AUTHOR
245:
246: Nicholas DeClario <nick@declario.com>
247:
248: =head1 BUGS
249:
250: This is a work in progress. Please report all bugs to the author.
251:
252: =head1 SEE ALSO
253:
254: =head1 COPYRIGHT
255:
256: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>