example/modules/DateRanges.pm

# $Id: DateRanges.pm,v 1.2 2002/01/28 13:00:02 whmoseley Exp $

package DateRanges;
use strict;

=head1 NAME

DateRanges

=head1 SYNOPSIS

    use DateRanges;
    use CGI;
    my $cgi = CGI->new();
     ...

    my %hash = (
        date_ranges     => {

            # Define what buttons to include
            time_periods    => [
                'All',
                'Today',
                'Yesterday',
                #'Yesterday onward',
                'This Week',
                'Last Week',
                'Last 90 Days',
                'This Month',
                'Last Month',
                #'Past',
                #'Future',
                #'Next 30 Days',
            ],

            # Default button
            default         => 'All',

            # Should buttons be in a row or a column?
            line_break      => 0,

            # Should a date input form be shown, too?
            date_range      => 1,
        },
    );

    
=head1 DESCRIPTION

This module provides I<basic> support for entering and using date ranges.  It
was written to use with swish-e (http://swish-e.org).

See swish.cgi in the swish-e distribution for an example.

Sorry about the interface -- if anyone really wants to use this please let me know and I'll
rewrite as OO interface!

=head1 FUNCTIONS

=cut

require Exporter;

use vars qw/$VERSION @ISA @EXPORT/;


@ISA = qw(Exporter);
$VERSION = '0.01';

@EXPORT = qw (
    DateRangeForm
    DateRangeParse
    GetDateRangeArgs
);

    # what to pick from
    my @TIME_PERIODS = (
        'Today',
        'Yesterday',
        'Yesterday onward',
        'This Week',
        'Last Week',
        'Last 90 Days',
        'This Month',
        'Last Month',
        'Past',
        'Future',
        'Next 30 Days',
        'All'
    );

    my %TIME_PERIODS = map { $_, 1} @TIME_PERIODS;


use Date::Calc qw /
    Day_of_Week_to_Text
    Day_of_Week
    Date_to_Text
    Monday_of_Week
    Week_of_Year
    Today
    Add_Delta_Days
    Days_in_Month
    check_date
/;

use Time::Local;


=item DateRangeForm( $cgi, $params, $fields );

This function simple creates a simple form for selecting date ranges based
on the fields passed in C<$params>.  Will call C<die()> on errors.

C<$params> must be a hash reference with a key named C<time_periods> as shown in
B<SYNOPSIS> above.  This is used to select which time periods to display.

C<$fields> is a reference to a hash where C<DateRanges> returns data.

These store the HTML for display on your form.

    buttons - the buttons to select the different time ranges
    date_range_button - the button to select a date range
    date_range_low - the low range select form fields
    date_range_hi  - the hight range select form fields

=cut

sub DateRangeForm {
    my ( $CGI, $params, $fields ) = @_;

    die "Must supply arrary ref for 'options'"
        unless $params->{time_periods} && ref $params->{time_periods} eq 'ARRAY';

    my @time_periods = grep { $TIME_PERIODS{$_} } @{ $params->{time_periods} };


    $fields->{buttons} = '';
    $fields->{date_range_button} = '';
    $fields->{date_range_low}  =  '';
    $fields->{date_range_high} =  '';

    $fields->{buttons} = 
          $CGI->radio_group( 
            -name       => 'DateRanges_date_option',
            -values     => \@time_periods,
            -default    => ($params->{default} || $time_periods[0]),
            -linebreak  => (exists $params->{line_break} ? $params->{line_break} : 1),
            #-columns=>2,
          ) if @time_periods;


    return unless $params->{date_range};

    $fields->{date_range_button} = 
        $CGI->radio_group(
            -name       => 'DateRanges_date_option',
            -values     => ['Select Date Range'],
            -default    => ($params->{default} || $time_periods[0]),
            -linebreak  => (exists $params->{line_break} ? $params->{line_break} : 1),
          );


    $fields->{date_range_low}  =  show_date_input($CGI, 'start');
    $fields->{date_range_high} =  show_date_input($CGI, 'end');

=pod
    print '<br>Limit to the hour of: ',
          popup_menu( -name       => 'Limit_hour',
                      -default    => ' ',
                      -values     => [' ',0..23], ),
          '<br>';
=cut          
          
}

=item my $args = GetDateRangeArgs( $cgi );

Returns a string to use in a HREF with all the parameters set.

=cut

sub GetDateRangeArgs {
    my $CGI = shift;

    my %args;

    
    $args{DateRanges_date_option} = $CGI->param('DateRanges_date_option')
        if defined $CGI->param('DateRanges_date_option');


    for ( qw/ mon day year / ) {
        my $start = "DateRanges_start_$_";
        my $end   =  "DateRanges_end_$_";
        $args{$start} = $CGI->param($start) if defined $CGI->param($start);
        $args{$end} = $CGI->param($end) if defined $CGI->param($end);
    }

    return '' unless %args;

    return join '&amp;', map { "$_=" . $CGI->escape($args{$_}) } keys %args;
    
}

=item DateRangeParse( $cgi, $form )

Parses the date range form and returns a low and high range unix timestamp.
Returns false on error with the folowing key set in C<$form>:

    DateRanges_error - error string explaining the problem

C<$form> is a hash reference where the following keys may be set:

    All - no date ranges were selected
    DateRanges_time_low - low range unix timestamp
    DateRanges_time_high - high range unix timestamp

=cut    
    

#------------------------ Get the report dates ---------------------
sub DateRangeParse {
    my ( $q, $form ) = @_;

    $form->{DateRanges_error} = '';
    

    # If requesting ALL (or not found in form) return true for all
    if ( !$q->param('DateRanges_date_option') || $q->param('DateRanges_date_option') eq 'All' ) {
        $form->{All}++;
        return 1;
    }

    my $time = time();

    my ( @start, @end );

    for ($q->param('DateRanges_date_option') ) {
    
        /^Today/      && do { @start = @end = Today(); last; };

        /^Yesterday onward/  && do { @start = Add_Delta_Days( Today(), -1 ); last };
        
        /^Yesterday/  && do { @start = @end = Add_Delta_Days( Today(), -1 ); last };


        /^This Week/ && do {
            @start = Monday_of_Week( Week_of_Year( Today() ) );
            @end   = Add_Delta_Days( @start, 6 );
            last;
        };

        /^Last Week/ && do {
            @start = Monday_of_Week( Week_of_Year( Add_Delta_Days( Today(), -7 ) ) );
            @end   = Add_Delta_Days( @start, 6 );
            last;
        };

        /^This Month/ && do {
            @start = @end = Today();
            $start[2] = 1;
            $end[2] = Days_in_Month($end[0],$end[1]);
            last;
        };
        
        /^Last Month/ && do {
            @start = Today();
            $start[2] = 1;
            --$start[1];
            if ( $start[1] == 0 ) {
                $start[1] = 12;
                $start[0]--;
            }
            @end = @start;
            $end[2] = Days_in_Month($end[0],$end[1]);
            last;
        };

        /^Last 90 Days/ && do {
            @end = Today();
            @start = Add_Delta_Days( Today(), -90 );
            last
        };

        /^Past/ && return 1;  # use defaults;

        /^Future/ && do {
            $form->{DateRanges_time_low} = time;
            delete $form->{DateRanges_time_high};
            return 1;
        };

        /^Next 30 Days/   && do {
            @start = Today();
            @end = Add_Delta_Days( Today(), +30 );
            last
        };
        

        /^Select/ && do {
            my ( $day, $mon, $year );

            $day    = $q->param('DateRanges_start_day') || 0;
            $mon    = $q->param('DateRanges_start_mon') || 0;
            $year   = $q->param('DateRanges_start_year') || 0;
            @start = ( $year, $mon, $day );

            $day    = $q->param('DateRanges_end_day') || 0;
            $mon    = $q->param('DateRanges_end_mon') || 0;
            $year   = $q->param('DateRanges_end_year') || 0;
            @end = ( $year, $mon, $day );
            last;
        };

        $form->{DateRanges_error} = 'Invalid Date Option ' . $q->param('DateRanges_date_option') . ' Selected';
        return;
    }


    $form->{DateRanges_error} = 'Invalid Start Date' && return if @start && !check_date( @start );
    $form->{DateRanges_error} = 'Invalid Ending Date' && return if @end && !check_date( @end );


    my $start_time = @start ? timelocal( 0, 0, 0, $start[2], $start[1]-1, $start[0]-1900 ) : 0;
    my $end_time   = @end   ? timelocal( 59, 59, 23, $end[2], $end[1]-1, $end[0]-1900 ) : 0;


    $form->{DateRanges_error} = "Starting time should be before now, don't you think?" && return
        if $start_time && $start_time > time();
        
    $form->{DateRanges_error} = 'Start date must be same day or before end date' && return
        if $start_time && $end_time && $start_time > $end_time;


    $form->{DateRanges_time_low} = $start_time;
    $form->{DateRanges_time_high} = $end_time;
    return 1;
}


#----------------------------------------------------------------------------
sub show_date_input {
    my ( $CGI, $name ) = @_;

    $name = "DateRanges_$name";

    my @months = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
    my $x = 1;
    my %months = map { $x++, $_ } @months;

    my ($mon, $day, $year) = (localtime)[4,3,5];

    $year = $year + 1900;
    $mon++;

    my $cur_year = $year;

    $cur_year += 5;

    ($year,$mon,$day) = Date::Calc::Add_Delta_Days($year,$mon,$day, -28 ) if $name eq 'start';


    my $str = join "\n", 
        $CGI->popup_menu(
            -name   => "${name}_mon",
            -values     => [1..12],
            -default    => $mon,
            -labels     => \%months
        ),
        '&nbsp',
        $CGI->popup_menu(
            -name       => "${name}_day",
            -default    => $day,
            -values     => [1..31],
        ),

        '&nbsp',
        $CGI->popup_menu(
            -name       => "${name}_year",
            -default    => $year,
            -values     => [$year-5..$cur_year],
        );


    return $str;
}

#----------------------- ymd_to_unix --------------------------
# Silly Date::Calc
sub ymd_to_unix {
    my ($y, $m, $d ) = @_;
    $m--;
    $y -= 1900;
    return timelocal( 0, 0, 0, $d, $m, $y );
}

1;

=back

=head1 COPYRIGHT

Copyright 2001 Bill Moseley

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1	adcroft	1.1	# $Id: DateRanges.pm,v 1.2 2002/01/28 13:00:02 whmoseley Exp $
2
3			package DateRanges;
4			use strict;
5
6			=head1 NAME
7
8			DateRanges
9
10			=head1 SYNOPSIS
11
12			use DateRanges;
13			use CGI;
14			my $cgi = CGI->new();
15			...
16
17			my %hash = (
18			date_ranges => {
19
20			# Define what buttons to include
21			time_periods => [
22			'All',
23			'Today',
24			'Yesterday',
25			#'Yesterday onward',
26			'This Week',
27			'Last Week',
28			'Last 90 Days',
29			'This Month',
30			'Last Month',
31			#'Past',
32			#'Future',
33			#'Next 30 Days',
34			],
35
36			# Default button
37			default => 'All',
38
39			# Should buttons be in a row or a column?
40			line_break => 0,
41
42			# Should a date input form be shown, too?
43			date_range => 1,
44			},
45			);
46
47
48
49
50			=head1 DESCRIPTION
51
52			This module provides I<basic> support for entering and using date ranges. It
53			was written to use with swish-e (http://swish-e.org).
54
55			See swish.cgi in the swish-e distribution for an example.
56
57			Sorry about the interface -- if anyone really wants to use this please let me know and I'll
58			rewrite as OO interface!
59
60			=head1 FUNCTIONS
61
62			=cut
63
64			require Exporter;
65
66			use vars qw/$VERSION @ISA @EXPORT/;
67
68
69			@ISA = qw(Exporter);
70			$VERSION = '0.01';
71
72			@EXPORT = qw (
73			DateRangeForm
74			DateRangeParse
75			GetDateRangeArgs
76			);
77
78			# what to pick from
79			my @TIME_PERIODS = (
80			'Today',
81			'Yesterday',
82			'Yesterday onward',
83			'This Week',
84			'Last Week',
85			'Last 90 Days',
86			'This Month',
87			'Last Month',
88			'Past',
89			'Future',
90			'Next 30 Days',
91			'All'
92			);
93
94			my %TIME_PERIODS = map { $_, 1} @TIME_PERIODS;
95
96
97			use Date::Calc qw /
98			Day_of_Week_to_Text
99			Day_of_Week
100			Date_to_Text
101			Monday_of_Week
102			Week_of_Year
103			Today
104			Add_Delta_Days
105			Days_in_Month
106			check_date
107			/;
108
109			use Time::Local;
110
111
112			=item DateRangeForm( $cgi, $params, $fields );
113
114			This function simple creates a simple form for selecting date ranges based
115			on the fields passed in C<$params>. Will call C<die()> on errors.
116
117			C<$params> must be a hash reference with a key named C<time_periods> as shown in
118			B<SYNOPSIS> above. This is used to select which time periods to display.
119
120			C<$fields> is a reference to a hash where C<DateRanges> returns data.
121
122			These store the HTML for display on your form.
123
124			buttons - the buttons to select the different time ranges
125			date_range_button - the button to select a date range
126			date_range_low - the low range select form fields
127			date_range_hi - the hight range select form fields
128
129			=cut
130
131			sub DateRangeForm {
132			my ( $CGI, $params, $fields ) = @_;
133
134			die "Must supply arrary ref for 'options'"
135			unless $params->{time_periods} && ref $params->{time_periods} eq 'ARRAY';
136
137			my @time_periods = grep { $TIME_PERIODS{$_} } @{ $params->{time_periods} };
138
139
140			$fields->{buttons} = '';
141			$fields->{date_range_button} = '';
142			$fields->{date_range_low} = '';
143			$fields->{date_range_high} = '';
144
145			$fields->{buttons} =
146			$CGI->radio_group(
147			-name => 'DateRanges_date_option',
148			-values => \@time_periods,
149			-default => ($params->{default} \|\| $time_periods[0]),
150			-linebreak => (exists $params->{line_break} ? $params->{line_break} : 1),
151			#-columns=>2,
152			) if @time_periods;
153
154
155			return unless $params->{date_range};
156
157			$fields->{date_range_button} =
158			$CGI->radio_group(
159			-name => 'DateRanges_date_option',
160			-values => ['Select Date Range'],
161			-default => ($params->{default} \|\| $time_periods[0]),
162			-linebreak => (exists $params->{line_break} ? $params->{line_break} : 1),
163			);
164
165
166
167			$fields->{date_range_low} = show_date_input($CGI, 'start');
168			$fields->{date_range_high} = show_date_input($CGI, 'end');
169
170			=pod
171			print '<br>Limit to the hour of: ',
172			popup_menu( -name => 'Limit_hour',
173			-default => ' ',
174			-values => [' ',0..23], ),
175			'<br>';
176			=cut
177
178			}
179
180			=item my $args = GetDateRangeArgs( $cgi );
181
182			Returns a string to use in a HREF with all the parameters set.
183
184			=cut
185
186			sub GetDateRangeArgs {
187			my $CGI = shift;
188
189			my %args;
190
191
192			$args{DateRanges_date_option} = $CGI->param('DateRanges_date_option')
193			if defined $CGI->param('DateRanges_date_option');
194
195
196			for ( qw/ mon day year / ) {
197			my $start = "DateRanges_start_$_";
198			my $end = "DateRanges_end_$_";
199			$args{$start} = $CGI->param($start) if defined $CGI->param($start);
200			$args{$end} = $CGI->param($end) if defined $CGI->param($end);
201			}
202
203			return '' unless %args;
204
205			return join '&', map { "$_=" . $CGI->escape($args{$_}) } keys %args;
206
207			}
208
209			=item DateRangeParse( $cgi, $form )
210
211			Parses the date range form and returns a low and high range unix timestamp.
212			Returns false on error with the folowing key set in C<$form>:
213
214			DateRanges_error - error string explaining the problem
215
216			C<$form> is a hash reference where the following keys may be set:
217
218			All - no date ranges were selected
219			DateRanges_time_low - low range unix timestamp
220			DateRanges_time_high - high range unix timestamp
221
222			=cut
223
224
225
226
227			#------------------------ Get the report dates ---------------------
228			sub DateRangeParse {
229			my ( $q, $form ) = @_;
230
231			$form->{DateRanges_error} = '';
232
233
234
235			# If requesting ALL (or not found in form) return true for all
236			if ( !$q->param('DateRanges_date_option') \|\| $q->param('DateRanges_date_option') eq 'All' ) {
237			$form->{All}++;
238			return 1;
239			}
240
241			my $time = time();
242
243			my ( @start, @end );
244
245			for ($q->param('DateRanges_date_option') ) {
246
247			/^Today/ && do { @start = @end = Today(); last; };
248
249			/^Yesterday onward/ && do { @start = Add_Delta_Days( Today(), -1 ); last };
250
251			/^Yesterday/ && do { @start = @end = Add_Delta_Days( Today(), -1 ); last };
252
253
254			/^This Week/ && do {
255			@start = Monday_of_Week( Week_of_Year( Today() ) );
256			@end = Add_Delta_Days( @start, 6 );
257			last;
258			};
259
260			/^Last Week/ && do {
261			@start = Monday_of_Week( Week_of_Year( Add_Delta_Days( Today(), -7 ) ) );
262			@end = Add_Delta_Days( @start, 6 );
263			last;
264			};
265
266			/^This Month/ && do {
267			@start = @end = Today();
268			$start[2] = 1;
269			$end[2] = Days_in_Month($end[0],$end[1]);
270			last;
271			};
272
273			/^Last Month/ && do {
274			@start = Today();
275			$start[2] = 1;
276			--$start[1];
277			if ( $start[1] == 0 ) {
278			$start[1] = 12;
279			$start[0]--;
280			}
281			@end = @start;
282			$end[2] = Days_in_Month($end[0],$end[1]);
283			last;
284			};
285
286			/^Last 90 Days/ && do {
287			@end = Today();
288			@start = Add_Delta_Days( Today(), -90 );
289			last
290			};
291
292			/^Past/ && return 1; # use defaults;
293
294			/^Future/ && do {
295			$form->{DateRanges_time_low} = time;
296			delete $form->{DateRanges_time_high};
297			return 1;
298			};
299
300			/^Next 30 Days/ && do {
301			@start = Today();
302			@end = Add_Delta_Days( Today(), +30 );
303			last
304			};
305
306
307
308			/^Select/ && do {
309			my ( $day, $mon, $year );
310
311			$day = $q->param('DateRanges_start_day') \|\| 0;
312			$mon = $q->param('DateRanges_start_mon') \|\| 0;
313			$year = $q->param('DateRanges_start_year') \|\| 0;
314			@start = ( $year, $mon, $day );
315
316			$day = $q->param('DateRanges_end_day') \|\| 0;
317			$mon = $q->param('DateRanges_end_mon') \|\| 0;
318			$year = $q->param('DateRanges_end_year') \|\| 0;
319			@end = ( $year, $mon, $day );
320			last;
321			};
322
323			$form->{DateRanges_error} = 'Invalid Date Option ' . $q->param('DateRanges_date_option') . ' Selected';
324			return;
325			}
326
327
328
329			$form->{DateRanges_error} = 'Invalid Start Date' && return if @start && !check_date( @start );
330			$form->{DateRanges_error} = 'Invalid Ending Date' && return if @end && !check_date( @end );
331
332
333			my $start_time = @start ? timelocal( 0, 0, 0, $start[2], $start[1]-1, $start[0]-1900 ) : 0;
334			my $end_time = @end ? timelocal( 59, 59, 23, $end[2], $end[1]-1, $end[0]-1900 ) : 0;
335
336
337			$form->{DateRanges_error} = "Starting time should be before now, don't you think?" && return
338			if $start_time && $start_time > time();
339
340			$form->{DateRanges_error} = 'Start date must be same day or before end date' && return
341			if $start_time && $end_time && $start_time > $end_time;
342
343
344			$form->{DateRanges_time_low} = $start_time;
345			$form->{DateRanges_time_high} = $end_time;
346			return 1;
347			}
348
349
350			#----------------------------------------------------------------------------
351			sub show_date_input {
352			my ( $CGI, $name ) = @_;
353
354			$name = "DateRanges_$name";
355
356			my @months = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
357			my $x = 1;
358			my %months = map { $x++, $_ } @months;
359
360			my ($mon, $day, $year) = (localtime)[4,3,5];
361
362			$year = $year + 1900;
363			$mon++;
364
365			my $cur_year = $year;
366
367			$cur_year += 5;
368
369			($year,$mon,$day) = Date::Calc::Add_Delta_Days($year,$mon,$day, -28 ) if $name eq 'start';
370
371
372			my $str = join "\n",
373			$CGI->popup_menu(
374			-name => "${name}_mon",
375			-values => [1..12],
376			-default => $mon,
377			-labels => \%months
378			),
379			'&nbsp',
380			$CGI->popup_menu(
381			-name => "${name}_day",
382			-default => $day,
383			-values => [1..31],
384			),
385
386			'&nbsp',
387			$CGI->popup_menu(
388			-name => "${name}_year",
389			-default => $year,
390			-values => [$year-5..$cur_year],
391			);
392
393
394			return $str;
395			}
396
397			#----------------------- ymd_to_unix --------------------------
398			# Silly Date::Calc
399			sub ymd_to_unix {
400			my ($y, $m, $d ) = @_;
401			$m--;
402			$y -= 1900;
403			return timelocal( 0, 0, 0, $d, $m, $y );
404			}
405
406			1;
407
408			=back
409
410			=head1 COPYRIGHT
411
412			Copyright 2001 Bill Moseley
413
414			This library is free software; you can redistribute it and/or
415			modify it under the same terms as Perl itself.
416
417			=cut
418