[ic] Scheduling module -- so far

Tim Good tim.g at edsd.com
Tue Dec 16 14:09:08 EST 2003


Ok all,

I intend on sharing my travels through developing a
scheduling / rental module 
for interchange. I have seen other posts concerning /wanting
such a module so here's my  
attempt. 

Due to the fact I am new to IC tags and Perl language, I
intend on developing functionality first then optimizing
code later unless someone has a suggestion.

ALL input and help is very welcome. I have developed a
usertag called cal.tag, 4 new fields in the transactions
table (delivery_date, delivery_time, 
pickup_date, pickup_time), two new menu tabs in Orders
(Delivery, Pickup), and 
template pages corresponding to menu tabs. 

Intentions: 

1) Intended use -> Party equipment rental.
2) Quote compilation according to available items in
non-rented inventory.
3) Restocking of items upon return from rental (with a
cleaning period before available).
4) Limited daily schedule for items to be delivered and for
items to be picked up.
5) maybe more to come after base (baby steps eh).

The user tag is as follows:
UserTag cal Order year month
UserTag cal addAttr
UserTag cal Documentation <<EOF

=pod

This tag uses the cal(1) command to display a calendar.

Options:

    month=numeric month value
    year=numeric year

Example:

	[cal year=2003 month=November]

=cut

EOF

UserTag cal Routine <<EOR
sub {
my ($in_year, $in_month) = @_;

my $get_schedule = sub {
   my ( $cal_day ) = @_;
   my $today = $Tag->convert_date( { raw => 1, body =>
$cal_day } );
   my $sql = "select fname,lname from transactions where
order_ymd like $today";

   my ($results, $col_name_hashref, $col_name_arrayref) =
$Tag->query({ wantarray => 1, sql => $sql, table =>
"transactions"});
   
   my $out = '';
   #loop through each row & display the days scheduled
deliveries.
   for (my $row=0; $row <= $#$results; $row++) {
      $out .= '<br>' . $results->[$row]->[0];
      $out .= ' ' . $results->[$row]->[1];
   }
return $out;
};

my @month_names = (
    'null', 'january', 'february', 'march', 'april', 'may',
'june',
    'july', 'august', 'september', 'october', 'november',
'december' );

my @days_in_month = ( 0, 31, 28, 31, 30, 31, 30, 31, 31, 30,
31, 30, 31,);

my $leap_year;
$leap_year = sub {
    my( $year ) = @_;
    my( %leaps ) = (
        1972 => 1972, 1976 => 1976, 1980 => 1980, 1984 =>
1984,
        1988 => 1988, 1992 => 1992, 1996 => 1996, 2000 =>
2000,
        2004 => 2004, 2008 => 2008, 2012 => 2012, 2016 =>
2016,
        2020 => 2020, 2024 => 2024, 2028 => 2028, 2032 =>
2032,
        2036 => 2036, 2040 => 2040, 2044 => 2044, 2048 =>
2048,
    );

    return 1 if $leaps{ $year };
    return 0;
};

my $perpetual_calendar;
$perpetual_calendar = sub {
#
# This perpetual calendar was detailed on a wallet-sized
card published # by Arthur A. Merrill and Popular Science in
1952. # # This subroutine takes the month and year as
arguments and returns what # "type" of month it is [0-6].
Not coincidently, this is also the day of # the week the
month starts on, where Sunday is a "0" and Saturday is a
"6". # my( $year, $month ) = @_;

 my %year_code = (
        '1970'=>'D', '1971'=>'E', '1972'=>'M', '1973'=>'A',
'1974'=>'B',
        '1975'=>'C', '1976'=>'K', '1977'=>'F', '1978'=>'G',
'1979'=>'A',

        '1980'=>'I', '1981'=>'D', '1982'=>'E', '1983'=>'F',
'1984'=>'N',
        '1985'=>'B', '1986'=>'C', '1987'=>'D', '1988'=>'L',
'1989'=>'G',

        '1990'=>'A', '1991'=>'B', '1992'=>'J', '1993'=>'E',
'1994'=>'F',
        '1995'=>'G', '1996'=>'H', '1997'=>'C', '1998'=>'D',
'1999'=>'E',

        '2000'=>'M', '2001'=>'A', '2002'=>'B', '2003'=>'C',
'2004'=>'K',
        '2005'=>'F', '2006'=>'G', '2007'=>'A', '2008'=>'I',
'2009'=>'D',

        '2010'=>'E', '2011'=>'F', '2012'=>'N', '2013'=>'B',
'2014'=>'C',
        '2015'=>'D', '2016'=>'L', '2017'=>'G', '2018'=>'A',
'2019'=>'B',

        '2020'=>'J', '2021'=>'E', '2022'=>'F', '2023'=>'G',
'2024'=>'H',
        '2025'=>'C', '2026'=>'D', '2027'=>'E', '2028'=>'M',
'2029'=>'A',

        '2030'=>'B', '2031'=>'C', '2032'=>'K', '2033'=>'F',
'2034'=>'G',
        '2035'=>'A', '2036'=>'I', '2037'=>'D', '2038'=>'E',
'2039'=>'F',

        '2040'=>'N', '2041'=>'B', '2042'=>'C', '2043'=>'D',
'2044'=>'L',
        '2045'=>'G', '2046'=>'A', '2047'=>'B', '2048'=>'J',
'2049'=>'E',  );

 my $calendar = 0;
    if ( $month == 1 ) {
        if ( $year_code{$year} =~ /[EL]/ ) { $calendar = 5 }
        elsif ( $year_code{$year} =~ /[GN]/ ) { $calendar =
0 }
        elsif ( $year_code{$year} =~ /[DK]/ ) { $calendar =
4 }
        elsif ( $year_code{$year} =~ /[AH]/ ) { $calendar =
1 }
        elsif ( $year_code{$year} =~ /[CJ]/ ) { $calendar =
3 }
        elsif ( $year_code{$year} =~ /[BI]/ ) { $calendar =
2 }
        elsif ( $year_code{$year} =~ /[FM]/ ) { $calendar =
6 }
    }
    elsif ( $month == 2 ) {
        if ( $year_code{$year} =~ /[BI]/ ) { $calendar = 5 }
        elsif ( $year_code{$year} =~ /[DK]/ ) { $calendar =
0 }
        elsif ( $year_code{$year} =~ /[AH]/ ) { $calendar =
4 }
        elsif ( $year_code{$year} =~ /[EL]/ ) { $calendar =
1 }
        elsif ( $year_code{$year} =~ /[GN]/ ) { $calendar =
3 }
        elsif ( $year_code{$year} =~ /[FM]/ ) { $calendar =
2 }
        elsif ( $year_code{$year} =~ /[CJ]/ ) { $calendar =
6 }
    }
    elsif ( $month == 3 ) {
        if ( $year_code{$year} =~ /[BH]/ ) { $calendar = 5 }
        elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar =
0 }
        elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar =
4 }
        elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar =
1 }
        elsif ( $year_code{$year} =~ /[GM]/ ) { $calendar =
3 }
        elsif ( $year_code{$year} =~ /[FL]/ ) { $calendar =
2 }
        elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar =
6 }
    }
    elsif ( $month == 4 ) {
        if ( $year_code{$year} =~ /[FL]/ ) { $calendar = 5 }
        elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar =
0 }
        elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar =
4 }
        elsif ( $year_code{$year} =~ /[BH]/ ) { $calendar =
1 }
        elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar =
3 }
        elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar =
2 }
        elsif ( $year_code{$year} =~ /[GM]/ ) { $calendar =
6 }
    }
    elsif ( $month == 5 ) {
        if ( $year_code{$year} =~ /[DJ]/ ) { $calendar = 5 }
        elsif ( $year_code{$year} =~ /[FL]/ ) { $calendar =
0 }
        elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar =
4 }
        elsif ( $year_code{$year} =~ /[GM]/ ) { $calendar =
1 }
        elsif ( $year_code{$year} =~ /[BH]/ ) { $calendar =
3 }
        elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar =
2 }
        elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar =
6 }
    }
    elsif ( $month == 6 ) {
        if ( $year_code{$year} =~ /[AN]/ ) { $calendar = 5 }
        elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar =
0 }
        elsif ( $year_code{$year} =~ /[GM]/ ) { $calendar =
4 }
        elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar =
1 }
        elsif ( $year_code{$year} =~ /[FL]/ ) { $calendar =
3 }
        elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar =
2 }
        elsif ( $year_code{$year} =~ /[BH]/ ) { $calendar =
6 }
    }
    elsif ( $month == 7 ) {
        if ( $year_code{$year} =~ /[FL]/ ) { $calendar = 5 }
        elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar =
0 }
        elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar =
4 }
        elsif ( $year_code{$year} =~ /[BH]/ ) { $calendar =
1 }
        elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar =
3 }
        elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar =
2 }
        elsif ( $year_code{$year} =~ /[GM]/ ) { $calendar =
6 }
    }
    elsif ( $month == 8 ) {
        if ( $year_code{$year} =~ /[CI]/ ) { $calendar = 5 }
        elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar =
0 }
        elsif ( $year_code{$year} =~ /[BH]/ ) { $calendar =
4 }
        elsif ( $year_code{$year} =~ /[FL]/ ) { $calendar =
1 }
        elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar =
3 }
        elsif ( $year_code{$year} =~ /[GM]/ ) { $calendar =
2 }
        elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar =
6 }
    }
    elsif ( $month == 9 ) {
        if ( $year_code{$year} =~ /[GM]/ ) { $calendar = 5 }
        elsif ( $year_code{$year} =~ /[BH]/ ) { $calendar =
0 }
        elsif ( $year_code{$year} =~ /[FL]/ ) { $calendar =
4 }
        elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar =
1 }
        elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar =
3 }
        elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar =
2 }
        elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar =
6 }
    }
    elsif ( $month == 10 ) {
        if ( $year_code{$year} =~ /[EK]/ ) { $calendar = 5 }
        elsif ( $year_code{$year} =~ /[GM]/ ) { $calendar =
0 }
        elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar =
4 }
        elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar =
1 }
        elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar =
3 }
        elsif ( $year_code{$year} =~ /[BH]/ ) { $calendar =
2 }
        elsif ( $year_code{$year} =~ /[FL]/ ) { $calendar =
6 }
    }
    elsif ( $month == 11 ) {
        if ( $year_code{$year} =~ /[BH]/ ) { $calendar = 5 }
        elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar =
0 }
        elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar =
4 }
        elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar =
1 }
        elsif ( $year_code{$year} =~ /[GM]/ ) { $calendar =
3 }
        elsif ( $year_code{$year} =~ /[FL]/ ) { $calendar =
2 }
        elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar =
6 }
    }
    elsif ( $month == 12 ) {
        if ( $year_code{$year} =~ /[GM]/ ) { $calendar = 5 }
        elsif ( $year_code{$year} =~ /[BH]/ ) { $calendar =
0 }
        elsif ( $year_code{$year} =~ /[FL]/ ) { $calendar =
4 }
        elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar =
1 }
        elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar =
3 }
        elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar =
2 }
        elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar =
6 }
    }
return $calendar;
};

#-----------------------------------------------------------
---------------

my $sensible_dates;
$sensible_dates = sub {
    my( $mod_year, $mod_month ) = @_;

    #
    # verify and adjust the month according to the desired
month or modifier
    #
    my $month = 1 + (localtime(time))[4];
    if    ( $mod_month =~ /jan/i ) { $month = 1; }
    elsif ( $mod_month =~ /feb/i ) { $month = 2; }
    elsif ( $mod_month =~ /mar/i ) { $month = 3; }
    elsif ( $mod_month =~ /apr/i ) { $month = 4; }
    elsif ( $mod_month =~ /may/i ) { $month = 5; }
    elsif ( $mod_month =~ /jun/i ) { $month = 6; }
    elsif ( $mod_month =~ /jul/i ) { $month = 7; }
    elsif ( $mod_month =~ /aug/i ) { $month = 8; }
    elsif ( $mod_month =~ /sep/i ) { $month = 9; }
    elsif ( $mod_month =~ /oct/i ) { $month = 10; }
    elsif ( $mod_month =~ /nov/i ) { $month = 11; }
    elsif ( $mod_month =~ /dec/i ) { $month = 12; }
    if ( $mod_month =~ /next/i ) {
        if ( $month == 12 ) { $month = 1; $mod_year += 1; }
        else { $month += 1; }
    }
    elsif ( $mod_month =~ /prev/i ) {
        if ( $month == 1 ) { $month = 12; $mod_year -= 1; }
        else { $month -= 1; }
    }
    elsif ( $mod_month =~ /^\d+$/ ) {
        if (($mod_month > 0) and ($mod_month < 13)) { $month
= $mod_month; }
    }

    #
    # verify and adjust the year according to the modifiers
    #
    my $year = 1900 + (localtime(time))[5];
    if ( $mod_year =~ /next/i ) { $year += 1; }
    elsif ( $mod_year =~ /prev/i ) { $year -= 1; }
    elsif ( $mod_year =~ /^\d{4}$/ ) { $year = $mod_year; }

    return( $year, $month );
};

my $build_next_month_href;
$build_next_month_href = sub {
#
# build the href for the "next month" link
#
    my( $url, $year, $month ) = @_;

    if ( $month == 12 ) { $month = 1; $year += 1; }
    else { $month += 1; }

    return
qq|$url?month=$month_names[$month]&amp;year=$year|;
};

#
------------------------------------------------------------
----------

my $build_previous_month_href;
$build_previous_month_href = sub {
#
# build the href for the "previous month" link
#
    my( $url, $year, $month ) = @_;

    if ( $month == 1 ) { $month = 12; $year -= 1; }
    else { $month -= 1; }


    return
qq|$url?month=$month_names[$month]&amp;year=$year|;
};

#
------------------------------------------------------------
----------

    my( $year, $month ) = $sensible_dates->(
$in_year,$in_month );
    my $url = $ENV{'SCRIPT_NAME'};
    my $prev_href = $build_previous_month_href->( $url,
$year, $month );
    my $next_href = $build_next_month_href->( $url, $year,
$month );


    #
    # Let's figure out the table decorations.  Stylesheets
are preferred,
    # but background colors will be tolerated.
    #
    my $head_attribute = 'CLASS="heading"';
    $head_attribute = qq|BGCOLOR="blue"|;

    my $event_attribute = 'CLASS="event"';
    $event_attribute = qq|BGCOLOR="yellow"|;

    my $cell_attribute = 'CLASS="cell"';
    $cell_attribute = qq|BGCOLOR="green"|;

    # find the cellpadding and cellspacing, if desired
    my $cellpadding = '';
    my $cellspacing = '';
    $cellpadding = qq|CELLPADDING="2"|;
    $cellspacing = qq|CELLSPACING="2"|;

    # find the table and cell sizes if desired
    my $table_width = '';
    my $cell_width = '';
    my $width = 400;
	if ( $width =~ /^\d+$/ ) { 
	    $cell_width = qq|WIDTH="| . int($width/7) .
qq|"|;
	}
	else { $cell_width = 'WIDTH="15%"'; }
	$table_width = qq|WIDTH="$width"|;

    my $cell_height = '';
    $cell_height .= qq|HEIGHT="55"|;

    # put together the heading of the table
    my $table = <<"EOH";
<TABLE $table_width $cellpadding $cellspacing BORDER="1">
<TR VALIGN="top">
<TH $head_attribute>
 <a href=$prev_href>Previous Month</a>
</TH> 
<TH $head_attribute COLSPAN="5">
<B>\u$month_names[$month] $year</B></TH>
<TH $head_attribute>
 <a href=$next_href>Next Month</a>
</TH> 
</TR>
EOH

    # the cell headings with the days of the week
    $table .= <<"EOH";
<TR VALIGN=top>
<TH $head_attribute $cell_width>Sunday</TH>
<TH $head_attribute $cell_width>Monday</TH>
<TH $head_attribute $cell_width>Tuesday</TH>
<TH $head_attribute $cell_width>Wednesday</TH>
<TH $head_attribute $cell_width>Thursday</TH>
<TH $head_attribute $cell_width>Friday</TH>
<TH $head_attribute $cell_width>Saturday</TH></TR>
EOH

    #
    # the space before the first day of the table
    #
    my $first_day = $perpetual_calendar->( $year, $month );
    if ( $first_day > 0 ) {

	$table .= <<"EOH";
<TD $cell_attribute $cell_height
COLSPAN="$first_day">&nbsp;</TD> EOH

    }

    #
    # show the "meat" of table
    #
    my $week_count = $first_day;
    my $days_in_this_month = $days_in_month[$month];
    if ( $month == 2  and $leap_year->( $year ) ) {
$days_in_this_month = 29; }
    for ( my $count = 1; $count <= $days_in_this_month;
$count++ ) {
        my $today = $year.$month.$count;
        my $sched = $get_schedule->($today);
        $table .= <<"EOH";
<TD $event_attribute $cell_width $cell_height VALIGN="top">
<B>$count</B><BR> $sched; </TD> EOH

	$week_count++;
	if ( $week_count == 7 and $count <
$days_in_this_month) { 
	    $table .= qq|</TR>\n<TR VALIGN="top">\n|;
	    $week_count = 0;
	}
    }

    #
    # add the remainder cells -- "&nbsp;" keeps the cell
from collapsing
    #
    if ( $week_count < 7 ) {
        my $days_left = 7 - $week_count;

        $table .= <<"EOH";
<TD $cell_attribute COLSPAN="$days_left">&nbsp;</TD></TR>
EOH

    }

    $table .= qq|</TABLE>\n|;
    return $table;
}
EOR

Hope this helps someone,

Tim




More information about the interchange-users mailing list