"Fossies" - the Fresh Open Source Software Archive

Member "absence-v2.1/cgi-bin/absence-click.pl" (20 Oct 2013, 20975 Bytes) of package /linux/www/web-absence-2.1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "absence-click.pl" see the Fossies "Dox" file reference documentation.

    1 #!/usr/bin/perl
    2 
    3 # $Id: absence-click.pl 111 2013-10-20 17:57:24Z urban $
    4 
    5 #==========================================================================
    6 # Welcome to "absence-click.pl"!
    7 #
    8 # It's a bit spaghetti-ish. Sorry about that.
    9 # This script is a bit complicated because it is called at two
   10 # stages.  First, it is called when a user clicks upon a month-image.
   11 # In this case, the tests for the existence of the show_absence and
   12 # create_absence CGI parameters fail, and processing starts at the
   13 # point marked "First entry-point".
   14 # The click-information is analyzed and then one of
   15 #   badClick()
   16 #   showAbsence()
   17 #   showHoliday()
   18 #   newAbsence()
   19 # is called (depending on whether client-side or server-side image-maps
   20 # have been configured).
   21 #
   22 # These functions display a form whose target is this script.
   23 # When the users clicks on the SUBMIT button in one of the forms,
   24 # the appropriate CGI parameters are set and this script is re-entered.
   25 #
   26 # The script performs the requested operation (adding a new reservation,
   27 # for example), and either causes a browswer redirect to the main
   28 # page (absence.pl) on success, or causes an error message to be
   29 # displayed.
   30 #
   31 # Everything is slightly complicated by the necessity of have the
   32 # "INSTANCE_NAME" environmental-variable set (if applicable) before
   33 # the AbsenceConfig module is loaded. The instance-information must
   34 # be passed to this script, and the method used to pass it is
   35 # different for stages 1 and 2.  In stage 1, the instance-name
   36 # is passed as part of the "extended path information" contained
   37 # in the URL.  In stage 2, the instance-name is passed as a
   38 # CGI parameter.
   39 #==========================================================================
   40 
   41 #======================================================================
   42 #    This file is part of Absence.
   43 #
   44 #    Absence is free software: you can redistribute it and/or modify
   45 #    it under the terms of the GNU General Public License as published by
   46 #    the Free Software Foundation, either version 3 of the License, or
   47 #    (at your option) any later version.
   48 #
   49 #    Absence is distributed in the hope that it will be useful,
   50 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
   51 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   52 #    GNU General Public License for more details.
   53 #
   54 #    You should have received a copy of the GNU General Public License
   55 #    along with Absence.  If not, see <http://www.gnu.org/licenses/>.
   56 #======================================================================
   57 
   58 use CGI qw/:standard/;
   59 use Carp;
   60 use MIME::Base64;
   61 #use Data::Dumper;
   62 
   63 
   64 $Data::Dumper::Indent = 1;
   65 
   66 # uncomment the following if you are debugging
   67 #use CGI::Carp qw(fatalsToBrowser);
   68 
   69 my $q;
   70 BEGIN {
   71     $q = new CGI;
   72     $q->import_names;
   73     $q->charset('utf-8');
   74 
   75     #system("echo 'PATH_INFO=$ENV{PATH_INFO}' > /tmp/foo.xx");
   76     if (exists($ENV{PATH_INFO}) && ($ENV{PATH_INFO} =~ m!/in=([^/?]+)!)) {
   77         $ENV{INSTANCE_NAME} = $1;
   78         #system("echo 'instance=$1' >> /tmp/foo.xx");
   79     } elsif (defined($Q::instance)) {
   80         $ENV{INSTANCE_NAME} = $Q::instance;
   81     }
   82 }
   83 
   84 use AbsenceConfig;
   85 use AbsenceImage;
   86 use AbsenceDB;
   87 use AbsenceLog;
   88 use AbsenceAuthentication;
   89 use AbsenceAuthorization;
   90 
   91 my %MONTH_LABELS = (
   92     1   => 'January',
   93     2   => 'February',
   94     3   => 'March',
   95     4   => 'April',
   96     5   => 'May',
   97     6   => 'June',
   98     7   => 'July',
   99     8   => 'August',
  100     9   => 'September',
  101     10  => 'October',
  102     11  => 'November',
  103     12  => 'December',
  104 );
  105 my $DEBUG = 0;
  106 $SIG{__DIE__} = \&handleError;
  107 
  108 # various paths to scripts and pages
  109 my $MAIN_SCRIPT     = AbsenceConfig::fetch('main_script');
  110 my $COLOR_NOPRIV    = AbsenceConfig::fetch('wp_nopriv');
  111 my $COLOR_MANAGE    = AbsenceConfig::fetch('wp_manage');
  112 my $COLOR_AFLABEL   = AbsenceConfig::fetch('wp_aflabel');
  113 my $COLOR_AFBG      = AbsenceConfig::fetch('wp_afbg');
  114 
  115 #my $TOP_PAGE       = AbsenceConfig::fetch('top_page');
  116 
  117 my $VERSION     = '2.0.1';
  118 
  119 $CGI::POST_MAX = 300;
  120 $CGI::DISABLE_UPLOADS = 1;
  121 
  122 if (exists($ENV{INSTANCE_NAME})) {
  123     $MAIN_SCRIPT .= "?instance=$ENV{INSTANCE_NAME}";
  124 }
  125 
  126 #----------------------------------------------------------------
  127 # preparation for dealing with GET requests...
  128 #----------------------------------------------------------------
  129 #my $GET = 0;
  130 #my $REFERER;
  131 #if ($ENV{HTTP_REFERER} =~ /[?&]group_id=\d+/) {
  132 #   #print "---GET---<BR>\n";
  133 #   $GET = 1;
  134 #   $REFERER = encode_base64($ENV{HTTP_REFERER});
  135 #}
  136 
  137 #-----------------------------------------------------------------
  138 # first, authenticate if necessary
  139 #-----------------------------------------------------------------
  140 my $AUTH_UID = AbsenceAuthentication::checkAuthentication($q);
  141 
  142 
  143 if (defined($Q::show_absence)) {
  144     if ($Q::show_absence =~ /^save/i) {
  145         modifyAbsence($q);
  146         exit;
  147     } elsif ($Q::show_absence eq 'Delete') {
  148         deleteAbsence($q);
  149         exit;
  150     } elsif ($Q::show_absence eq 'Cancel') {
  151         print $q->redirect($MAIN_SCRIPT);
  152         exit(0);
  153     } else {
  154         print "whoops!\n";
  155     }
  156 }
  157 
  158 if (defined($Q::create_absence)) {
  159     createAbsence($q);
  160     exit(0);
  161 }
  162 
  163 #-------------------------------------------------------------------
  164 # First entry-point.
  165 #
  166 # if I got here, it means the script has been called after a user
  167 # clicked on one of the month-images
  168 #-------------------------------------------------------------------
  169 print $q->header();
  170 
  171 my @keywords = $q->keywords;
  172 my $stuff = $keywords[0];
  173 my ($key, @result);
  174 
  175 #-------------------------------------------------------------------
  176 # The encoding of absence information depends on whether map_type
  177 # is set to 'client' or 'server'
  178 #-------------------------------------------------------------------
  179 if (AbsenceConfig::fetch('map_type') eq 'server') {
  180     if ($ENV{'PATH_INFO'} !~ m!^(/in=[^/]+)?/(\d+)-(\d+)-(\d+)$!) {
  181         die "failed to match [$ENV{'PATH_INFO'}]";
  182     }
  183     my $gid = $2;
  184     my $month = $3;
  185     my $year = $4;
  186     my ($x, $y);
  187     if ($stuff =~ m!^(\d+),(\d+)$!) {
  188         $x = $1;
  189         $y = $2;
  190         #print "month [$month], year [$year], x [$x], y [$y]<BR>\n";
  191     } else {
  192         print "map_type = server, unable to parse [$stuff]<BR>\n";
  193     }
  194     @result = AbsenceImage::findAbsence($month, $year, $gid, $x, $y);
  195     $key = $result[0];
  196 } else {
  197     if ($stuff =~ /res,(\d+)$/) {
  198         @result = (absence => $1);
  199         $key = 'absence';
  200     } elsif ($stuff =~ /new,(\d+),(\d+),(\d+),(\d+),(\d+)$/) {
  201         ($pid,$gid,$day,$month,$year) = ($1, $2, $3, $4, $5);
  202         $DEBUG && abslog("pid=$pid, gid=$gid, day=$day, mon=$month, year=$year");
  203         @result = (start => [$pid, $day, $month, $year]);
  204         $key = 'start';
  205     } else {
  206         print "map_type = client, unable to parse [$stuff]\n";
  207     }
  208 }
  209 
  210 if ($key eq 'none') {
  211     badClick($q, $result[1]);
  212 } elsif ($key eq 'absence') {
  213     showAbsence($q, \@result);
  214 } elsif ($key eq 'holiday') {
  215     showHoliday($q, \@result);
  216 } elsif ($key eq 'start') {
  217     newAbsence($q, \@result);
  218 } else {
  219     print "findAbsence error. returned: [@result]<BR>\n";
  220 }
  221 
  222 #print "<P>ENV:<BR>\n";
  223 #foreach my $key (keys(%ENV)) {
  224 #   print "[$key] $ENV{$key}<BR>\n";
  225 #}
  226 
  227 if ($DEBUG) {
  228     my @names = $q->param;
  229 
  230     print "Parameters:<BR>\n";
  231     foreach my $p (@names) {
  232         print " [$p]<BR>\n";
  233     }
  234 
  235     print "<P>Keywords:<BR>\n";
  236     foreach my $p (@keywords) {
  237         print " [$p]<BR>\n";
  238     }
  239 }
  240 
  241 print $q->end_html();
  242 
  243 exit;
  244 
  245 #====================================================================
  246 # subs
  247 #====================================================================
  248 
  249 sub handleError
  250 {
  251     my $msg = shift;
  252     confess($msg);
  253 }
  254 
  255 #------------------------------------------------------------------
  256 # deleteAbsence()
  257 #
  258 # user has clicked on "Delete" in the show/modify/delete form
  259 #------------------------------------------------------------------
  260 
  261 sub deleteAbsence
  262 {
  263     my $q = shift;
  264 
  265     my $msg;
  266 
  267     #abslog("res_id=[$Q::res_id]");
  268     my $res = AbsenceDB::getReservation($Q::res_id);
  269     if (!defined($res)) {
  270         print $q->header();
  271         print $q->start_html(
  272             -title      => 'Absence: no-action',
  273             -BGCOLOR    => $COLOR_AFBG,
  274         );
  275         print "Absence was deleted by someone else<BR>\n";
  276         reloadMain($q);
  277         exit;
  278     }
  279     
  280     my $pid = AbsenceDB::getReservation($Q::res_id)->{object_id};
  281     if (!AbsenceAuthorization::allowWriteForPerson($AUTH_UID, $pid)) {
  282         print $q->header();
  283         print $q->start_html(
  284             -title      => 'Absence: delete an absence',
  285             -target     => 'display',
  286             -BGCOLOR    => $COLOR_NOPRIV,
  287         );
  288         print "<H1>no authorization</H1><BR>\n";
  289         print $q->end_html();
  290         exit 0;
  291     }
  292 
  293     my $ret = AbsenceDB::deleteReservation($Q::res_id);
  294 
  295     if ($ret eq 'ok') {
  296         print $q->redirect($MAIN_SCRIPT);
  297         #print "Successfully completed.<BR>\n";
  298         exit(0);
  299     } elsif ($ret eq 'conflict') {
  300         $msg = "Looks like someone else got there first.<BR>\n";
  301     } elsif ($ret eq 'internalerror') {
  302         $msg = "internal error. (sorry)<BR>\n";
  303     }
  304 
  305     print $q->header();
  306     print $q->start_html(
  307         -title => 'Absence: delete absence',
  308         -target => 'display',
  309         -BGCOLOR    => $COLOR_AFBG,
  310     );
  311     print $msg;
  312     print $q->start_form(-action => $MAIN_SCRIPT, -method => 'POST');
  313     print $q->submit(action => 'Jump back to Calendar');
  314     print $q->end_form();
  315     print $q->end_html();
  316 }
  317 
  318 #------------------------------------------------------------------
  319 # modifyAbsence()
  320 #
  321 # user has clicked on "Save Changes" in the show/modify/delete form
  322 #------------------------------------------------------------------
  323 
  324 sub modifyAbsence
  325 {
  326     my $q = shift;
  327 
  328     #my $start = "$Q::sday.$Q::smonth.$Q::syear";
  329     #my $end = "$Q::eday.$Q::emonth.$Q::eyear";
  330 
  331     my $start = { day => $Q::sday, month => $Q::smonth, year => $Q::syear };
  332     my $end = { day => $Q::eday, month => $Q::emonth, year => $Q::eyear };
  333 
  334     my $msg;
  335 
  336     if (!AbsenceAuthorization::allowWriteForPerson($AUTH_UID, $Q::person_id)) {
  337         print $q->header();
  338         print $q->start_html(
  339             -title      => 'Absence: modify an absence',
  340             -target     => 'display',
  341             -bgcolor    => $COLOR_NOPRIV,
  342         );
  343         print "<H1>no authorization</H1><BR>\n";
  344         print $q->end_html();
  345         exit 0;
  346     }
  347 
  348     my ($ret, $addit) = AbsenceDB::addReservation($Q::res_id, $Q::person_id,
  349         $start, $end, $Q::type_id, $Q::desc);
  350 
  351     #print "AbsenceDB::addReservation returned [$ret]<BR>\n";
  352 
  353     if ($ret eq 'ok') {
  354         print $q->redirect($MAIN_SCRIPT);
  355         #print "<P>Absence successfully modified.<BR>\n";
  356         exit(0);
  357     } elsif ($ret eq 'disappeared') {
  358         $msg = "<P>ERROR: The requested absence has been deleted.\n";
  359     } elsif ($ret eq 'impossible') {
  360         $msg = "<P>ERROR: The requested absence ends before it starts!\n";
  361     } elsif ($ret eq 'conflict') {
  362         $msg = conflictMessage($addit, $Q::res_id);
  363     }
  364 
  365     print $q->header();
  366     print $q->start_html(
  367         -title => 'Absence: modify an existing absence',
  368         -target => 'display',
  369         -BGCOLOR    => $COLOR_AFBG,
  370     );
  371 
  372     print "<H1>Modify an Absence:</H1><BR>\n";
  373 
  374     print $msg;
  375 
  376     print $q->start_form(-action => $MAIN_SCRIPT, -method => 'POST');
  377     print $q->submit(action => 'Jump back to Calendar');
  378     print $q->end_form();
  379     print $q->end_html();
  380 }
  381 
  382 sub conflictMessage
  383 {
  384     my ($addit, $res_id) = @_;
  385 
  386     my $msg;
  387 
  388     if ($addit->{type} eq 'simple') {
  389         my $res = $addit->{res};
  390         my $type = AbsenceDB::getType($res->{type_id});
  391         $msg = "<P>ERROR: The requested absence would overlap "
  392             ."with an existing one:<BR>\n"
  393             ."Start: $res->{start}<BR>"
  394             ."End: $res->{end}<BR>"
  395             ."Type: $type->{name}<BR>"
  396             ."Description: $res->{description}<BR>\n"
  397             ."Please select a new start/end date.<BR>\n";
  398     } elsif ($addit->{type} eq 'no_space') {
  399         my $m = AbsenceDate::monthName($addit->{month});
  400         $msg = qq{<P>ERROR: Not enough space is available in $m, $addit->{year} for the requested reservation.};
  401     } else {
  402         my $id = ($addit->{ids}->[0] eq $res_id)
  403             ? $addit->{ids}->[1]
  404             : $addit->{ids}->[0];
  405         my $res = AbsenceDB::getReservation($id);
  406         my $type = AbsenceDB::getType($res->{type_id});
  407         $msg = qq/The requested reservation would coincide illegally with the following reservation:<BR>Type: $type->{name}<BR>Description: $res->{description}<BR>Start: $res->{start}<BR>End: $res->{finish}<BR>/;
  408     }
  409 
  410     return $msg;
  411 }
  412 
  413 #------------------------------------------------------------------
  414 # newAbsence()
  415 #
  416 # display a form to allow the create of a new absence
  417 #------------------------------------------------------------------
  418 
  419 sub createAbsence
  420 {
  421     my $q = shift;
  422 
  423     if ($Q::create_absence eq 'Cancel') {
  424         print $q->redirect($MAIN_SCRIPT);
  425         exit(0);
  426     }
  427 
  428     if (!AbsenceAuthorization::allowWriteForPerson($AUTH_UID, $Q::person_id)) {
  429         print $q->header();
  430         print $q->start_html(
  431             -title      => 'Absence: create a new absence',
  432             -target     => 'display',
  433             -BGCOLOR    => $COLOR_NOPRIV,
  434         );
  435         print "<H1>no authorization</H1><BR>\n";
  436         print $q->end_html();
  437         exit 0;
  438 
  439         #print $q->start_form(-action => $MAIN_SCRIPT, -method => 'POST');
  440         #print $q->submit(action => 'Jump back to Calendar');
  441         #print $q->end_form();
  442     }
  443 
  444     my $start = { day => $Q::sday, month => $Q::smonth, year => $Q::syear };
  445     my $end = { day => $Q::eday, month => $Q::emonth, year => $Q::eyear };
  446 
  447     my $msg;
  448 
  449     my ($ret, $addit) = AbsenceDB::addReservation('new', $Q::person_id,
  450         $start, $end, $Q::type_id, $Q::desc);
  451 
  452     print "AbsenceDB::addReservation returned [$ret]<BR>\n";
  453     if ($ret eq 'ok') {
  454         print $q->redirect($MAIN_SCRIPT);
  455         #print "<P>Absence successfully created.<BR>\n";
  456         exit(0);
  457     } elsif ($ret eq 'impossible') {
  458         $msg = "<P>ERROR: The requested absence ends before it starts!\n";
  459     } elsif ($ret eq 'conflict') {
  460         $msg = conflictMessage($addit, 'new');
  461     } elsif ($ret eq 'badday') {
  462         $msg = "<P>ERROR: start or end date invalid (past end of month)\n";
  463     }
  464 
  465     print $q->header();
  466     print $q->start_html(
  467         -title      => 'Absence: create a new absence',
  468         -target     => 'display',
  469         -BGCOLOR    => $COLOR_AFBG,
  470     );
  471     print "<H1>Create Absence Error</H1><BR>\n";
  472 
  473     print $msg;
  474 
  475     print $q->start_form(-action => $MAIN_SCRIPT, -method => 'POST');
  476     print $q->submit(action => 'Jump back to Calendar');
  477     print $q->end_form();
  478     print $q->end_html();
  479 }
  480 
  481 sub newAbsence
  482 {
  483     my ($q, $rref) = @_;
  484 
  485     my $sref = $rref->[1];
  486 
  487     my $pid = $sref->[0];
  488     if (!AbsenceAuthorization::allowWriteForPerson($AUTH_UID, $pid)) {
  489         print $q->start_html(
  490             -title      => 'Absence: error: unauthorized',
  491             -bgcolor    => $COLOR_NOPRIV,
  492         );
  493         my $name = AbsenceDB::getPerson($pid, 'name');
  494         print "<H3>You are not authorized to create an absence for [$name]</H3>\n";
  495         print $q->end_html();
  496         exit;
  497     }
  498 
  499     print $q->start_html(
  500         -title      => 'Absence: create a new absence',
  501         -bgcolor    => $COLOR_AFBG,
  502     );
  503 
  504     print $q->h1("Create a new absence");
  505 
  506     absenceForm(new => $sref);
  507 
  508     print $q->submit(create_absence => 'Save Changes'),
  509         $q->submit(create_absence => 'Cancel');
  510 
  511     print $q->end_form;
  512 }
  513 
  514 sub showAbsence
  515 {
  516     my ($q, $rref) = @_;
  517 
  518     print $q->start_html(
  519         -title      => 'Absence: display/modify an absence',
  520         -BGCOLOR    => $COLOR_AFBG,
  521     );
  522 
  523     # DEBUG
  524     #print qq[<PRE>\n], Dumper($q), qq[\n</PRE>\n];
  525     #print "REFERER: $ENV{HTTP_REFERER}<BR>\n";
  526     #if ($ENV{HTTP_REFERER} =~ /[?&]group_id=\d+/) {
  527     #   print "---GET---<BR>\n";
  528     #}
  529 
  530     print $q->h1("Display or Modify an absence");
  531 
  532     my $res_id = $rref->[1];
  533     my $res = AbsenceDB::getReservation($res_id);
  534     if (!defined($res)) {
  535         #print "error: reservation id [$res_id] not found.<BR>\n";
  536         print "Absence was deleted by someone else<BR>\n";
  537         reloadMain($q);
  538         exit;
  539 
  540     } else {
  541         absenceForm(show => $res);
  542         my $pid = $res->{object_id};
  543         if (AbsenceAuthorization::allowWriteForPerson($AUTH_UID, $pid)) {
  544             print $q->submit(show_absence => 'Save Changes'),
  545                 $q->submit(show_absence => 'Cancel'),
  546                 $q->submit(show_absence => 'Delete');
  547         } else {
  548             print $q->submit(show_absence => 'Cancel');
  549         }
  550         print $q->end_form;
  551     }
  552 }
  553 
  554 sub reloadMain
  555 {
  556     my $q = shift;
  557 
  558     print $q->h1("Click on button below to reload calendar");
  559     print $q->start_form(
  560         #-action => $MAIN_PAGE,
  561         -action => $MAIN_SCRIPT,
  562         -method => 'POST',
  563         #-target    => '_parent',
  564     );
  565     print $q->submit(action => 'Jump back to Calendar');
  566     print $q->end_form();
  567     print $q->end_html();
  568 }
  569 
  570 sub absenceForm
  571 {
  572     my ($type, $ref) = @_;
  573 
  574     if ($DEBUG) {
  575         abslog(["absenceForm: res-id=[$ref->{id}], oid=[$ref->{object_id}]",
  576             "start: $ref->{start}",
  577             "finish: $ref->{finish}",
  578             "type-id=[$ref->{type_id}]",
  579             "desc=[$ref->{description}]",
  580         ]);
  581     }
  582 
  583     my ($pid);
  584 
  585     # handle default values
  586     my %def;
  587 
  588     if ($type eq 'show') {
  589         $pid = $ref->{object_id};
  590         my $s = AbsenceDB::convToAbsenceDate($ref->{start});
  591         ($def{sday}, $def{smonth}, $def{syear}) =
  592             ($s->{day}, $s->{month}, $s->{year});
  593             #AbsenceDB::convToAbsenceDate($ref->{start});
  594 
  595         my $e = AbsenceDB::convToAbsenceDate($ref->{finish});
  596         ($def{eday}, $def{emonth}, $def{eyear}) =
  597             ($e->{day}, $e->{month}, $e->{year});
  598             #AbsenceDB::convToAbsenceDate($ref->{finish});
  599 
  600         $def{type_id}   = $ref->{type_id};
  601         $def{desc}      = $ref->{description};
  602         $def{res_id}    = $ref->{id};
  603     } else {
  604         my $def_type = AbsenceDB::getDefaultType();
  605         my $def_type_id;
  606         if (defined($def_type)) {
  607             $def_type_id = $def_type->{id};
  608         }
  609 
  610         $pid = $ref->[0];
  611         $def{sday}      = $ref->[1];
  612         $def{smonth}    = $ref->[2];
  613         $def{syear}     = $ref->[3];
  614         $def{eday}      = $ref->[1];
  615         $def{emonth}    = $ref->[2];
  616         $def{eyear}     = $ref->[3];
  617         $def{type_id}   = $def_type_id;
  618         $def{desc}      = '';
  619         $def{res_id}    = '';
  620     }
  621 
  622     if ($DEBUG) {
  623         abslog("defaults:");
  624         foreach my $key (keys(%def)) {
  625             abslog("$key=[$def{$key}]");
  626         }
  627     }
  628 
  629     #my ($form_start_year, $form_end_year)
  630     my $max = ($def{syear} > $def{eyear}) ? $def{syear} : $def{eyear};
  631     my $year = (localtime)[5] + 1900;
  632     my $end_year = $year + 10;
  633     my $start_year = $year - 2;
  634     $end_year = ($max > $end_year) ? $max : $end_year;
  635 
  636     #my $bg = 'papayawhip';
  637     #my $bg = $COLOR_AFLABEL;
  638 
  639     my $person = AbsenceDB::getPerson($pid, 'name');
  640 
  641     #my $start = "$sref->[1]/$sref->[2]/$sref->[3]";
  642     #print "Add an absence for [$person] starting on $start.<BR>\n";
  643 
  644     print $q->start_form;
  645     print $q->hidden(-name => 'person_id', -default => $pid);
  646     print $q->hidden(-name => 'res_id', -default => $def{res_id});
  647     if (exists($ENV{INSTANCE_NAME})) {
  648         print $q->hidden(-name => 'instance', -default => $ENV{INSTANCE_NAME});
  649     }
  650     print "<TABLE>\n";
  651     #------------------------------------------------
  652     # person row
  653     #------------------------------------------------
  654     print "<TR><TH ALIGN=right BGCOLOR=$COLOR_AFLABEL>Person</TH><TD>$person</TD></TR>\n";
  655     #------------------------------------------------
  656     # begin row
  657     #------------------------------------------------
  658     print "<TR><TH ALIGN=right BGCOLOR=$COLOR_AFLABEL>Begin</TH><TD>";
  659     print $q->popup_menu(
  660         -name   => 'sday',
  661         -values => [1..31],
  662         -default=> $def{sday},
  663     );
  664     print $q->popup_menu(
  665         -name   => 'smonth',
  666         -values => [1..12],
  667         -default=> $def{smonth},
  668         -labels => \%MONTH_LABELS,
  669     );
  670     print $q->popup_menu(
  671         -name   => 'syear',
  672         -values => [$start_year..$end_year],
  673         -default=> $def{syear},
  674     );
  675     print "</TD></TR>\n";
  676     #------------------------------------------------
  677     # ending day row
  678     #------------------------------------------------
  679     print "<TR><TH ALIGN=right BGCOLOR=$COLOR_AFLABEL>End</TH><TD>";
  680     print $q->popup_menu(
  681         -name   => 'eday',
  682         -values => [1..31],
  683         -default=> $def{eday},
  684     );
  685     print $q->popup_menu(
  686         -name   => 'emonth',
  687         -values => [1..12],
  688         -default=> $def{emonth},
  689         -labels => \%MONTH_LABELS,
  690     );
  691     print $q->popup_menu(
  692         -name   => 'eyear',
  693         -values => [$start_year..$end_year],
  694         -default=> $def{eyear},
  695     );
  696     print "</TD></TR>\n";
  697     #------------------------------------------------
  698     # what row
  699     #------------------------------------------------
  700     my (%type_labels, @type_ids);
  701     my @types = AbsenceDB::getTypes();
  702     %type_labels = map { $_->{id} => $_->{name} } @types;
  703     @type_ids = map { $_->{id} } sort { lc($a->{name}) cmp lc($b->{name}) } @types;
  704     print "<TR><TH ALIGN=right BGCOLOR=$COLOR_AFLABEL>What</TH><TD>";
  705     print $q->popup_menu(
  706         -name   => 'type_id',
  707         #-values    => ['Vacation', 'Training', 'Travel', 'CV', 'Other'],
  708         #-values    => [AbsenceTypes::getTypes()],
  709         -values     => \@type_ids,
  710         -labels     => \%type_labels,
  711         -default    => $def{type_id},
  712     );
  713     print "</TD></TR>\n";
  714     #------------------------------------------------
  715     # long-desc row
  716     #------------------------------------------------
  717     print "<TR><TH ALIGN=right BGCOLOR=$COLOR_AFLABEL>Description</TH><TD>";
  718     print $q->textfield(
  719         -name       => 'desc',
  720         -size       => 50,
  721         -maxlength  => 100,
  722         -default    => $def{desc},
  723     );
  724     print "</TD></TR>\n";
  725     print "</TABLE>\n";
  726 }
  727 
  728 sub showHoliday
  729 {
  730     my ($q, $rref) = @_;
  731 
  732     print $q->start_html(
  733         -title      => 'Absence: Holiday',
  734         -BGCOLOR    => $COLOR_AFBG,
  735     );
  736 
  737     my $href = $rref->[1];
  738     my ($d, $m, $y, $holiday) = @{$href};
  739     my $mon = AbsenceDate::monthName($m, '-short');
  740     my $wd = AbsenceDate::weekDayFromDate($d, $m, $y, '-name');
  741     print $q->h1("$wd, $d-$mon-$y, is $holiday");
  742 }
  743 
  744 sub badClick
  745 {
  746     my ($q, $more) = @_;
  747 
  748     print $q->start_html(
  749         -title      => 'Absence: no-action',
  750         -BGCOLOR    => $COLOR_AFBG,
  751     );
  752     if ($more eq 'stop-that') {
  753         print "Don't click there again.<BR>\n";
  754         return;
  755     }
  756     print <<_EOF_;
  757 <P>Instructions:<BR>
  758 <UL>
  759     <LI>month-days coloured purple are holidays.  You can click
  760         on them to get the holiday.
  761     <LI>absences are blocks of red.  Clicking on them allows you to
  762         display, modify, and delete them.
  763     <LI>To create a new absence, click on the day in the person-row
  764         when the absence should start.
  765 </UL>
  766 _EOF_
  767 }