#!/v/guest/sw/bin/perl -w ############################################################################### ## ## ## Copyright (c) 2005 - 2009 by Steffen Beyer. ## ## All rights reserved. ## ## ## ## This program is free software; you can redistribute it ## ## and/or modify it under the same terms as Perl itself. ## ## ## ############################################################################### ####################################### ## ## ## See /datecalc/ for a "live" ## ## example of this CGI script. ## ## ## ####################################### BEGIN { eval { require bytes; }; } use strict; use Date::Calc qw(:all); my @date = ( Today() ); my @data = ( @date,0,0,0 ); my @diff = ( @date,@date ); &process_query_string(); unless ($data[3] == 0 and $data[4] == 0 and $data[5] == 0) { eval { if ($data[5] == 0) { @data[0..2] = Add_Delta_YM( @data[0..4] ); } else { @data[0..2] = Add_Delta_YMD( @data ); } @data[3..5] = (0,0,0); }; if ($@) { @data = ( @date,0,0,0 ); } } &print_page(); sub process_query_string() { my $query = $ENV{'QUERY_STRING'} || $ENV{'REDIRECT_QUERY_STRING'} || ''; my @pairs = split(/&/, $query); my($pair,$var,$val); foreach $pair (@pairs) { ($var,$val) = split(/=/,$pair,2); if ($var eq 'y') { if ($val =~ m!^[+-]?[0-9]+$! and $val >= 1 and $val <= 32767) { $data[0] = $val; } } elsif ($var eq 'm') { if ($val =~ m!^[+-]?[0-9]+$! and $val >= 1 and $val <= 12) { $data[1] = $val; } } elsif ($var eq 'd') { if ($val =~ m!^[+-]?[0-9]+$! and $val >= 1 and $val <= 31) { $data[2] = $val; } } elsif ($var eq 'dy') { if ($val =~ m!^[+-]?[0-9]+$!) { $data[3] = $val; } } elsif ($var eq 'dm') { if ($val =~ m!^[+-]?[0-9]+$!) { $data[4] = $val; } } elsif ($var eq 'dd') { if ($val =~ m!^[+-]?[0-9]+$!) { $data[5] = $val; } } elsif ($var eq 'y1') { if ($val =~ m!^[+-]?[0-9]+$! and $val >= 1 and $val <= 32767) { $diff[0] = $val; } } elsif ($var eq 'm1') { if ($val =~ m!^[+-]?[0-9]+$! and $val >= 1 and $val <= 12) { $diff[1] = $val; } } elsif ($var eq 'd1') { if ($val =~ m!^[+-]?[0-9]+$! and $val >= 1 and $val <= 31) { $diff[2] = $val; } } elsif ($var eq 'y2') { if ($val =~ m!^[+-]?[0-9]+$! and $val >= 1 and $val <= 32767) { $diff[3] = $val; } } elsif ($var eq 'm2') { if ($val =~ m!^[+-]?[0-9]+$! and $val >= 1 and $val <= 12) { $diff[4] = $val; } } elsif ($var eq 'd2') { if ($val =~ m!^[+-]?[0-9]+$! and $val >= 1 and $val <= 31) { $diff[5] = $val; } } } unless (check_date( @data[0..2] )) { @data[0..2] = @date; } unless (check_date( @diff[0..2] )) { @diff[0..2] = @date; } unless (check_date( @diff[3..5] )) { @diff[3..5] = @date; } } sub print_page() { my($date) = Date_to_Text_Long( @data[0..2] ); my $delta = Delta_Days(@diff); my $diff0 = join(', ', Enumerate( $delta,qw( day)) ); my $diff1 = join(', ', Enumerate( Delta_YMD(@diff),qw(year month day)) ); my $diff2 = join(', ', Enumerate(N_Delta_YMD(@diff),qw(year month day)) ); print <<"VERBATIM"; Content-type: text/html; charset="iso-8859-1" Steffen Beyer's Date Calculator

Steffen Beyer's Date Calculator

VERBATIM } sub Enumerate { my(@data) = @_; my($i); my $n = scalar(@data) >> 1; for ( $i = 0; $i < $n; $i++ ) { $data[$i] = ( ($data[$i] > 0) ? '+' : '' ) . $data[$i] . ' ' . $data[$i+$n] . ( (abs($data[$i]) == 1) ? '' : 's' ); } splice(@data,$n); return(@data); } __END__

+
Year	Month	Day	Delta-Year	Delta-Month	Delta-Day

$date

-
Year(1)	Month(1)	Day(1)	Year(2)	Month(2)	Day(2)

$diff0			(absolute semantics)
$diff1			(both one-by-one and left-to-right semantics)			$diff1	(one-by-one semantics)
$diff2			(left-to-right with truncation semantics)