"Fossies" - the Fresh Open Source Software Archive

Member "absence-v2.1/cgi-bin/AbsenceImage.pm" (15 Dec 2013, 57592 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 "AbsenceImage.pm" see the Fossies "Dox" file reference documentation.

    1 #======================================================================
    2 #    This file is part of Absence.
    3 #
    4 #    Absence is free software: you can redistribute it and/or modify
    5 #    it under the terms of the GNU General Public License as published by
    6 #    the Free Software Foundation, either version 3 of the License, or
    7 #    (at your option) any later version.
    8 #
    9 #    Absence is distributed in the hope that it will be useful,
   10 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
   11 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   12 #    GNU General Public License for more details.
   13 #
   14 #    You should have received a copy of the GNU General Public License
   15 #    along with Absence.  If not, see <http://www.gnu.org/licenses/>.
   16 #======================================================================
   17 
   18 # $Id: AbsenceImage.pm 116 2013-12-15 00:09:27Z urban $
   19 # copyright Robert Urban
   20 
   21 package AbsenceImage;
   22 
   23 use FileHandle;
   24 use GD;
   25 use Carp;
   26 use Data::Dumper;
   27 use Encode qw(from_to decode encode decode_utf8);
   28 
   29 use AbsenceConfig;
   30 use AbsenceDB;
   31 use AbsenceDate;
   32 #use AbsenceHolidays;
   33 #use AbsenceTypes;
   34 use AbsenceLog;
   35 
   36 use strict;
   37 
   38 # colors
   39 
   40 my %COLOR_VALUES = (
   41     bg          => getColorTriplet('mi_background'),
   42     altbg       => getColorTriplet('mi_altbg'),
   43     we          => getColorTriplet('mi_weekend'),
   44     bholiday    => getColorTriplet('mi_bankholiday'),
   45     text_dark   => getColorTriplet('mi_text_dark'),
   46     text_light  => getColorTriplet('mi_text_light'),
   47     grid        => getColorTriplet('mi_grid'),
   48     cw          => getColorTriplet('mi_cwbox'),
   49     padding     => getColorTriplet('mi_padding'),
   50     res_border  => getColorTriplet('mi_res_border'),
   51     white       => [ 0xff, 0xff, 0xff ],
   52     black       => [ 0x00, 0x00, 0x00 ],
   53 );
   54 
   55 my $FULL_HEIGHT     = 12;
   56 my $FULL_SLOTS      = 4;
   57 my $SLOT_PIXELS     = int($FULL_HEIGHT / $FULL_SLOTS);
   58 my $COL_HEIGHT      = 20;
   59 my $MULTI_RES       = AbsenceConfig::fetch('multi_res');
   60 my $MAX_MULTI       = AbsenceConfig::fetch('max_multi');
   61 my $MIN_HEIGHT      = AbsenceConfig::fetch('min_height');
   62 my $VARIABLE_HEIGHT = AbsenceConfig::fetch('variable_height');
   63 my $NUM_SLOTS       = $MAX_MULTI * $FULL_SLOTS;
   64 my %COLOR           = ();
   65 my $ROW_HEIGHT      = $MULTI_RES
   66     ? $MAX_MULTI * $FULL_HEIGHT + 1
   67     : $COL_HEIGHT;
   68 my $HEADER_ROW_HEIGHT   = 20;
   69 my $COL_WIDTH       = 20;
   70 my $HGRID_WIDTH     = $MULTI_RES ? 2 : 1;
   71 my $ROW_LABEL_WIDTH = 100;
   72 my $HEADER_LINES    = 2;
   73 my $CGI_DIR         = AbsenceConfig::fetch('cgi_dir_rel');
   74 my $MARK_CM         = AbsenceConfig::fetch('mark_curr_month');
   75 my $MARK_CD         = AbsenceConfig::fetch('mark_curr_day');
   76 my $HOLIDAY_MARK    = AbsenceConfig::fetch('holiday_mark');
   77 my $HOLIDAY_SCHEME  = AbsenceConfig::fetch('holiday_scheme');
   78 my $IMAGE_DIR_ABS   = AbsenceConfig::fetch('image_dir_abs');
   79 my $IMAGE_DIR_REL   = AbsenceConfig::fetch('image_dir_rel');
   80 my $SKIP_WE_HOL     = AbsenceConfig::fetch('skip_we_hol');
   81 my $SKIP_MARK_SK    = AbsenceConfig::fetch('skip_mark_skipped');
   82 my $NON_BLOCK_PRIO  = 100;
   83 
   84 my $HOL_SHOW_HEAD;
   85 my $HOL_HEAD_REGION;
   86 my $HOL_HEAD_COUNTRY;
   87 
   88 if ($HOLIDAY_SCHEME eq 'advanced') {
   89     $HOL_SHOW_HEAD      = AbsenceConfig::fetch('show_holidays_in_header');
   90     $HOL_HEAD_REGION    = AbsenceConfig::fetch('header_holiday_region');
   91     $HOL_HEAD_COUNTRY   = AbsenceConfig::fetch('header_holiday_country');
   92 }
   93 
   94 my %HEIGHT_MAP = (
   95     'full'      => { slots => $FULL_SLOTS,      pixels => $FULL_HEIGHT  },
   96     'half'      => { slots => $FULL_SLOTS/2,    pixels => $FULL_HEIGHT/2 },
   97     'quarter'   => { slots => $FULL_SLOTS/4,    pixels => $FULL_HEIGHT/4 },
   98 );
   99 
  100 #------------------------------------------------------------
  101 # only retrieve these if I need them
  102 #------------------------------------------------------------
  103 
  104 if ($MARK_CM || $MARK_CD) {
  105     $COLOR_VALUES{cm_bg}        = getColorTriplet('mi_cm_bg');
  106     $COLOR_VALUES{cm_altbg}     = getColorTriplet('mi_cm_altbg');
  107     $COLOR_VALUES{cm_we}        = getColorTriplet('mi_cm_weekend');
  108     $COLOR_VALUES{cm_grid}      = getColorTriplet('mi_cm_grid');
  109     $COLOR_VALUES{cm_monthlab}  = getColorTriplet('mi_cm_monthlab');
  110     $COLOR_VALUES{cm_mi_frame}  = getColorTriplet('mi_cm_mi_frame');
  111     $COLOR_VALUES{cm_cw}        = getColorTriplet('mi_cm_cwbox');
  112     $COLOR_VALUES{currday}      = getColorTriplet('mi_curr_day'),
  113 }
  114 
  115 my $DEBUG           = 0;
  116 my $HDEBUG          = 0;
  117 my $VERSION         = '2.0.1';
  118 
  119 my $I_HEIGHT;
  120 
  121 sub getColorTriplet
  122 {
  123     my $name = shift;
  124 
  125     my $str = AbsenceConfig::fetch($name);
  126 
  127     my @t;
  128     if (@t = ($str =~ /^(?:#|0x)?([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})$/))
  129     {
  130         return [map(hex, @t)];
  131     }
  132 
  133     if ($str =~ /^((0x[0-9a-fA-F]+|\d+)\s+){2}(0x[0-9a-fA-F]+|\d+)$/) {
  134         my $ref;
  135         foreach my $val (split(' ', $str)) {
  136             ($val =~ /0x/) ? push(@{$ref}, hex($val)) : push(@{$ref}, $val);
  137         }
  138 
  139         return $ref;
  140     }
  141 
  142     die "getColorTriplet: failed to match [$str] from [$name]";
  143 }
  144 
  145 sub create
  146 {
  147     my ($month, $year, $group_id, $image_outfile, $map_outfile, $mapname) = @_;
  148 
  149     my $debug = 0;
  150 
  151     $debug && abslog("\n%%% create() month=$month, year=$year");
  152 
  153     if (!$month || !$year) {
  154         confess "missing people, month, or year";
  155     }
  156 
  157     my $map_fh = FileHandle->new($map_outfile, 'w');
  158     defined($map_fh) || die "failed to open [$map_outfile] to write: $!";
  159     print $map_fh qq[<MAP NAME="$mapname">\n];
  160 
  161     my $numdays = AbsenceDate::daysInMonth($month, $year);
  162 
  163     #----------------------------------------------------------
  164     # get people
  165     #----------------------------------------------------------
  166     my @people = AbsenceDB::getPeople($group_id);
  167 
  168     #----------------------------------------------------------
  169     # calculate height of person-rows, if necessary
  170     # $pr_info is a reference to an array of object-ids, i.e.:
  171     #   $pr_info = [1] = { stuff for OID 1 },
  172     #   $pr_info = [5] = { stuff for OID 5 },
  173     #----------------------------------------------------------
  174     my $pr_info = layoutObjectRows($month, $year, \@people);
  175 
  176     #----------------------------------------------------------
  177     # calculate width of image
  178     #----------------------------------------------------------
  179     my $use_width = $ROW_LABEL_WIDTH + $numdays * $COL_WIDTH;
  180     my $i_width = $ROW_LABEL_WIDTH + 31 * $COL_WIDTH + 1;
  181 
  182     #----------------------------------------------------------
  183     # calculate height of image
  184     #----------------------------------------------------------
  185     my $pr_height = 0;
  186     foreach my $pid (@people) {
  187         #abslog(" HEIGHT[$pid] = $pr_info->[$pid]->{height}");
  188         $pr_height += $pr_info->[$pid]->{height};
  189     }
  190     #$I_HEIGHT = @people * $ROW_HEIGHT + $HEADER_LINES * $HEADER_ROW_HEIGHT + 1;
  191     $I_HEIGHT = (@people + 1) * $HGRID_WIDTH
  192         + $pr_height
  193         + $HEADER_LINES * $HEADER_ROW_HEIGHT;
  194 
  195     #----------------------------------------------------------
  196     # save dimensions in DB
  197     #----------------------------------------------------------
  198     AbsenceDB::updateImageDimensions(
  199         $group_id, $month, $year,
  200         $i_width, $I_HEIGHT,
  201     );
  202 
  203     #----------------------------------------------------------
  204     # create new image
  205     #----------------------------------------------------------
  206     my $im = new GD::Image($i_width, $I_HEIGHT, 1);
  207 
  208     #----------------------------------------------------------
  209     # allocate... you guessed it, colors
  210     #----------------------------------------------------------
  211     allocateColors($im);
  212     #$im->transparent($COLOR{bg});
  213 
  214     #----------------------------------------------------------
  215     # do background
  216     # I don't need to do this.  Because the background color
  217     # is allocated first (in "allocateColors()"), GD automagically
  218     # uses it for the background
  219     #----------------------------------------------------------
  220     $im->filledRectangle(0, 0, $i_width, $I_HEIGHT, $COLOR{bg});
  221 
  222     my ($month_label_color, $grid_color, $alt_bg);
  223 
  224     #----------------------------------------------------------
  225     # set colors depending on whether this is the current month
  226     #----------------------------------------------------------
  227     if ($MARK_CM && currentMonth($month, $year)) {
  228         $im->filledRectangle(0, 0, $i_width, $I_HEIGHT, $COLOR{cm_bg});
  229         $grid_color         = $COLOR{cm_grid};
  230         $month_label_color  = $COLOR{cm_monthlab};
  231         $alt_bg             = $COLOR{cm_altbg};
  232     } else {
  233         $grid_color         = $COLOR{grid};
  234         $month_label_color  = $COLOR{text_dark};
  235         $alt_bg             = $COLOR{altbg};
  236     }
  237 
  238     my $cur_y = $HEADER_LINES * $HEADER_ROW_HEIGHT + $HGRID_WIDTH;
  239 
  240     #----------------------------------------------------------
  241     # optionally add alternating bars in the people rows...
  242     #----------------------------------------------------------
  243     if (AbsenceConfig::fetch('alternate_colors')) {
  244         my $row = 0;
  245         my $y = $cur_y;
  246         foreach my $pid (@people) {
  247             my $row_height = $pr_info->[$pid]->{height};
  248             if (($row % 2) != 1) {
  249                 $im->filledRectangle(
  250                     0, $y,                              # (x1, y1)
  251                     $use_width, $y + $row_height - 1,   # (x2, y2)
  252                     $alt_bg,
  253                 );
  254             }
  255             $row++;
  256             $y += $row_height + $HGRID_WIDTH;
  257         }
  258     }
  259 
  260     #----------------------------------------------------------
  261     # if numdays != 31, add padding color
  262     #----------------------------------------------------------
  263     if ($numdays != 31) {
  264         my $x1 = $ROW_LABEL_WIDTH + $numdays * $COL_WIDTH + 1;
  265         #print "<BR>X1 = [$x1], X2 = [$i_width]<BR>\n";
  266         $im->filledRectangle(
  267             $x1, 0,
  268             $i_width, $I_HEIGHT,
  269             $COLOR{padding});
  270     }
  271 
  272     my $sav;
  273     $cur_y = $sav = $HEADER_LINES * $HEADER_ROW_HEIGHT;
  274 
  275     #----------------------------------------------------------
  276     # mark weekends
  277     #----------------------------------------------------------
  278     markWeekends($im, $month, $year);
  279     
  280     #----------------------------------------------------------
  281     # mark holidays
  282     #----------------------------------------------------------
  283     markHeaderHolidays($im, $month, $year, $map_fh);
  284 
  285     #----------------------------------------------------------
  286     # add month and year
  287     #----------------------------------------------------------
  288     $im->string(gdGiantFont, 10, 5, AbsenceDate::monthName($month),
  289         $month_label_color);
  290     $im->string(gdGiantFont, 10, 20, $year, $month_label_color);
  291 
  292     #----------------------------------------------------------
  293     # add CW bars
  294     #----------------------------------------------------------
  295     drawCwBars($im, $month, $year);
  296 
  297     #----------------------------------------------------------
  298     # mark current day, if configured to do so
  299     #----------------------------------------------------------
  300     if ($MARK_CD && currentMonth($month, $year)) {
  301         markCurrentDay($im, $month, $year);
  302     }
  303 
  304     #----------------------------------------------------------
  305     # draw vertical grid lines
  306     # horizontal lines must wait, except for first one
  307     #----------------------------------------------------------
  308 
  309     my $y2 = $cur_y + $HGRID_WIDTH - 1;
  310     $debug && abslog("first grid line. (0,$cur_y) ($use_width,$y2)");
  311 
  312     $im->filledRectangle(
  313         0, $cur_y,                          # (x1, y1)
  314         $use_width, $cur_y + $HGRID_WIDTH - 1,  # (x2, y2)
  315         $grid_color,
  316     );
  317     
  318     my $cur_x = $ROW_LABEL_WIDTH;
  319     $im->line($cur_x, $sav, $cur_x, $I_HEIGHT, $grid_color);
  320     $cur_x += $COL_WIDTH;
  321 
  322     if (AbsenceConfig::fetch('vertical_grid')) {
  323         for(my $i = 1; $i <= $numdays; $i++) {
  324             #print "line: $cur_x, $sav, $cur_x, $I_HEIGHT\n";
  325             $im->line($cur_x, $sav, $cur_x, $I_HEIGHT, $grid_color);
  326             $cur_x += $COL_WIDTH;
  327         }
  328     }
  329 
  330     $cur_y += $HGRID_WIDTH;
  331 
  332     #----------------------------------------------------------
  333     # add monthdays
  334     #----------------------------------------------------------
  335     $cur_x = $ROW_LABEL_WIDTH;
  336     for(my $i = 1; $i <= $numdays; $i++) {
  337         $im->string(gdSmallFont, $cur_x + 5, $HEADER_ROW_HEIGHT + 2, $i, $COLOR{text_dark});
  338         $cur_x += $COL_WIDTH;
  339     }
  340 
  341     #----------------------------------------------------------
  342     # build person-rows
  343     #----------------------------------------------------------
  344 
  345     my $x_offset = 5;
  346     my $fit_chars = int(($ROW_LABEL_WIDTH - $x_offset) / 6.0);
  347 
  348     my $row = 0;
  349     foreach my $pid (@people) {
  350         my $row_height = $pr_info->[$pid]->{height};
  351         #$debug && abslog("row-height = [$row_height]");
  352         my $pref = AbsenceDB::getPerson($pid);
  353 
  354         #----------------------------
  355         # add holidays, if configured
  356         #----------------------------
  357         if ($HOLIDAY_SCHEME eq 'advanced') {
  358             my @params;
  359             my $found = 0;
  360             if (defined($pref->{country_id})) {
  361                 push(@params, country => $pref->{country_id});
  362                 $found = 1;
  363             }
  364             if (defined($pref->{region_id})) {
  365                 push(@params, region => $pref->{region_id});
  366                 $found = 1;
  367             }
  368             
  369             if ($found) {
  370                 my @holidays = AbsenceDB::getHolidayList($month, $year, @params);
  371                 drawHolidays($im, \@holidays, $cur_y, $cur_y + $row_height - 1, 0, $numdays);
  372             }
  373         }
  374 
  375         #----------------------------
  376         # add people
  377         #----------------------------
  378         my $name = $pref->{name};
  379         from_to($name, 'utf8', 'iso-8859-1') || die "from_to failed, name=[$name]: $!";
  380         if (length($pref->{name}) > 15) {
  381             $name = substr($name, 0, $fit_chars);
  382         }
  383         my $y_offset = $cur_y + int($row_height / 2) - 7;
  384         #my $name_latin = decode_utf8($name);
  385         $im->string(gdSmallFont, $x_offset, $y_offset, $name, $COLOR{text_dark});
  386 
  387         #----------------------------
  388         # add absences
  389         #----------------------------
  390         $DEBUG && print "adding absences..\n";
  391         drawObjectRow($im, $pr_info->[$pid], $pid,
  392             $group_id, $cur_y, $month, $year, $map_fh);
  393         $cur_y += $row_height;
  394 
  395         #----------------------------
  396         # add horizontal grid line
  397         #----------------------------
  398         $y2 = $cur_y + $HGRID_WIDTH - 1;
  399         #$debug && abslog("hgrid-line: (0,$cur_y) ($use_width,$y2)");
  400         $im->filledRectangle(
  401             0, $cur_y,                          # (x1, y1)
  402             $use_width, $cur_y + $HGRID_WIDTH - 1,  # (x2, y2)
  403             $grid_color,
  404         );
  405         $cur_y += $HGRID_WIDTH;
  406     }
  407 
  408     #----------------------------------------------------------
  409     # mark current month, if configured
  410     #----------------------------------------------------------
  411     if ($MARK_CM && currentMonth($month, $year)) {
  412         $im->rectangle(0, 0, $use_width, $I_HEIGHT - 1, $COLOR{cm_mi_frame});
  413         $im->rectangle(1, 1, $use_width-1, $I_HEIGHT - 2, $COLOR{cm_mi_frame});
  414     }
  415 
  416     #----------------------------------------------------------
  417     # write image
  418     #----------------------------------------------------------
  419     open(OUT, '>', $image_outfile) || die "open";
  420     binmode(OUT);   # stoopid windoze
  421     my $it = AbsenceConfig::fetch('image_type');
  422     if ($it eq 'png') {
  423         print OUT $im->png;
  424     } elsif ($it eq 'gif') {
  425         print OUT $im->gif;
  426     } elsif ($it eq 'jpg') {
  427         print OUT $im->jpg;
  428     } else {
  429         die "unknown image_type [$it]";
  430     }
  431     close(OUT);
  432 
  433     print $map_fh "</MAP>\n";
  434     $map_fh->close;
  435 
  436     AbsenceDB::updateMonthModTime($group_id, $month, $year);
  437 }
  438 
  439 sub layoutObjectRows
  440 {
  441     my ($month, $year, $people_ref) = @_;
  442 
  443     my $pr_info = [];
  444     my $sum_heights = 0;
  445 
  446     foreach my $oid (@{ $people_ref }) {
  447         $DEBUG && abslog("\nlayoutObjectRows OID=$oid");
  448         my @res_list = AbsenceDB::getMonthReservations($oid, $month, $year);
  449         if ($MULTI_RES) {
  450             my $layout_ref = layoutObjectRow(\@res_list, $month, $year);
  451             $pr_info->[$oid] = {
  452                 height  => ($layout_ref->{last_slot} + 1) * $SLOT_PIXELS,
  453                 rects   => $layout_ref->{rects},
  454             };
  455         } else {
  456             $pr_info->[$oid] = {
  457                 height      => $COL_HEIGHT,
  458                 res_list    => \@res_list,
  459             };
  460         }
  461     }
  462 
  463     return $pr_info;
  464 }
  465 
  466 sub drawObjectRow
  467 {
  468     my ($im, $pr_info, $pid, $gid, $cur_y, $month, $year, $map_fh) = @_;
  469 
  470     if ($MULTI_RES) {
  471         my $rects_ref = $pr_info->{rects};
  472         defined($rects_ref) || die "drawObjectRow failed";
  473         foreach my $rect_ref (sort { $a->{prio} <=> $b->{prio} } @{ $rects_ref })
  474         {
  475             my $y1 = $cur_y + $rect_ref->{start_slot} * $SLOT_PIXELS;
  476             my $y2 = $cur_y + ($rect_ref->{start_slot} + $rect_ref->{num_slots})
  477                     * $SLOT_PIXELS - 1;
  478             #abslog("  rect: id=$rect_ref->{mres}->{res}->{id}, y1=$y1, y2=$y2");
  479             my $y_bounds = [ $y1, $y2 ];
  480             $rect_ref->{y_bounds} = $y_bounds;
  481             drawReservation($im, $y_bounds, $rect_ref->{mres}, $month, $year);
  482         }
  483         writeMultiMapAreas(
  484             $pid, $gid,
  485             [ $cur_y, $cur_y + $pr_info->{height} - 1 ],
  486             $month, $year, $rects_ref, $map_fh,
  487         );
  488     } else {
  489         my $res_list = $pr_info->{res_list};
  490         foreach my $ref (@{ $res_list }) {
  491             my $y1 = $cur_y;
  492             my $y2 = $cur_y + $ROW_HEIGHT - 1;
  493             $DEBUG && print "got res=$ref->{res}->{id}, start=$ref->{bounds}->{start}, end=$ref->{bounds}->{end}\n";
  494             drawReservation($im, [ $y1, $y2 ], $ref, $month, $year);
  495         }
  496         writeObjectRowMapAreas($pid, $gid, $month, $year, $cur_y, $map_fh);
  497     }
  498 }
  499 
  500 sub layoutObjectRow
  501 {
  502     my ($res_list, $month, $year) = @_;
  503 
  504     my $debug = 0;
  505     #$debug && abslog("**layoutObjectRow**");
  506 
  507     #---------------------------------------------------------------
  508     # if @res_list is empty, short-circuit
  509     #---------------------------------------------------------------
  510     if (!@{ $res_list }) {
  511         my $last_slot = $VARIABLE_HEIGHT
  512             ? $MIN_HEIGHT * $FULL_SLOTS - 1
  513             : $MAX_MULTI * $FULL_SLOTS - 1;
  514         return {
  515             last_slot   => $last_slot,
  516             rects       => [],
  517             error       => undef,
  518         };
  519     }
  520 
  521     my @blocks;
  522     my $numdays = AbsenceDate::daysInMonth($month, $year);
  523     my @day_info;
  524     my @day_info_b;
  525     for(my $d = 1; $d <= $numdays; $d++) {
  526         $day_info[$d] = { slots => [], types => [] };
  527         $day_info_b[$d] = { slots => [], types => [] };
  528     }
  529 
  530     #---------------------------------------------------------------
  531     # create a sortable list based on priority
  532     # non-block type reservations get sort_prio = priority
  533     # block type reservations get sort_prio > 100, where prio=0,
  534     #   sort_prio = 200, prio=99, sort_prio = 101
  535     #---------------------------------------------------------------
  536     my (@top_unsorted, @bottom_unsorted, @block_unsorted);
  537     foreach my $mres (@{ $res_list }) {
  538         my $type_id = $mres->{res}->{type_id};
  539         my $type_ref = AbsenceDB::getType($type_id);
  540         my $height = defined($type_ref->{height})
  541             ? $type_ref->{height}
  542             : 'full';
  543         my $prio = defined($type_ref->{priority})
  544             ? $type_ref->{priority}
  545             : 10;
  546         if ($height eq 'block') {
  547             $debug && abslog(" % rid=$mres->{res}->{id} --> block");
  548             push(@block_unsorted, {
  549                 prio    => $prio,
  550                 slots   => $NUM_SLOTS,
  551                 mres    => $mres,
  552             });
  553         } elsif ($prio >= 0) {
  554             $debug && abslog(" % rid=$mres->{res}->{id} --> top");
  555             push(@top_unsorted, {
  556                 prio    => $prio,
  557                 slots   => $HEIGHT_MAP{$height}->{slots},
  558                 mres    => $mres,
  559             });
  560         } else {
  561             $debug && abslog(" % rid=$mres->{res}->{id} --> bottom");
  562             push(@bottom_unsorted, {
  563                 prio    => $prio,
  564                 slots   => $HEIGHT_MAP{$height}->{slots},
  565                 mres    => $mres,
  566             });
  567         }
  568     }
  569 
  570     my @rects;
  571     my $t2b_lowest_slot;
  572     #---------------------------------------------------------------
  573     # top-to-bottom
  574     # sort according to order in which blocks need to be drawn on image
  575     # and attempt to fit on object-row
  576     #---------------------------------------------------------------
  577 
  578     foreach my $prio_group (sort_prio_groups(\@top_unsorted)) {
  579         foreach my $obj (@{ $prio_group }) {
  580             $debug && abslog("%% find slot for rid=[$obj->{mres}->{res}->{id}], num_slots=[$obj->{slots}], start=[$obj->{mres}->{bounds}->{start}], end=[$obj->{mres}->{bounds}->{end}]");
  581             my $starting_slot = findFreeSlotsFromTop(
  582                 $obj->{slots}, \@day_info,
  583                 $obj->{mres}->{bounds}->{start},
  584                 $obj->{mres}->{bounds}->{end},
  585             );
  586             my $e_slot = $starting_slot + $obj->{slots} - 1;
  587             $t2b_lowest_slot = $e_slot if ($t2b_lowest_slot < $e_slot);
  588             #$debug && abslog("  found starting slot [$starting_slot]");
  589             occupySlots($starting_slot, $obj->{slots}, \@day_info, $obj->{mres});
  590             push(@rects, {
  591                 prio        => $NON_BLOCK_PRIO,
  592                 mres        => $obj->{mres},
  593                 start_slot  => $starting_slot,
  594                 num_slots   => $obj->{slots},
  595             });
  596         }
  597     }
  598 
  599     #---------------------------------------------------------------
  600     # bottom-to-top
  601     # sort according to order in which blocks need to be drawn on image
  602     # and attempt to fit on object-row
  603     #---------------------------------------------------------------
  604 
  605     #-------------------------------------
  606     # figure out where to start
  607     #-------------------------------------
  608     my $slot_begin = $VARIABLE_HEIGHT ? 0 : $NUM_SLOTS - 1;
  609     my @b_rects;
  610     my $highest_slot = 0;
  611     my $b2t_lowest_slot = 0;
  612 
  613     foreach my $prio_group (sort_prio_groups(\@bottom_unsorted, '-reverse')) {
  614         foreach my $obj (@{ $prio_group }) {
  615             my ($start, $end) = (
  616                 $obj->{mres}->{bounds}->{start},
  617                 $obj->{mres}->{bounds}->{end},
  618             );
  619             $debug && abslog("%% find b2t slot for rid=[$obj->{mres}->{res}->{id}], num_slots=[$obj->{slots}], start=[$start], end=[$end]");
  620             my $starting_slot
  621                 = findFreeSlotsFromTop($obj->{slots}, \@day_info_b,
  622                     $start, $end);
  623             my $e_slot = $starting_slot + $obj->{slots} - 1;
  624             $b2t_lowest_slot = $e_slot if ($e_slot > $b2t_lowest_slot);
  625             $highest_slot = $starting_slot if ($starting_slot < $highest_slot);
  626             $debug && abslog("starting_slot=[$starting_slot], slots=[$obj->{slots}]");
  627             #defined($starting_slot) || return undef;
  628             occupySlots($starting_slot, $obj->{slots}, \@day_info_b, $obj->{mres});
  629             push(@b_rects, {
  630                 prio        => $NON_BLOCK_PRIO,
  631                 mres        => $obj->{mres},
  632                 start_slot  => $starting_slot,
  633                 num_slots   => $obj->{slots},
  634             });
  635         }
  636     }
  637 
  638     my $lowest_slot = ($t2b_lowest_slot > $b2t_lowest_slot)
  639         ? $t2b_lowest_slot
  640         : $b2t_lowest_slot;
  641 
  642     if (@b_rects) {
  643         $debug && abslog("b2t type reservations exist");
  644         $debug && abslog("min-height=$MIN_HEIGHT, lowest-slot=$b2t_lowest_slot");
  645         #-------------------------------------
  646         # figure out how much the b2t reservations have
  647         # to be shifted down to fit with the t2b reservations
  648         #-------------------------------------
  649         my $init_shift;
  650         if ($VARIABLE_HEIGHT) {
  651             $init_shift = ($lowest_slot > ($MIN_HEIGHT * $FULL_SLOTS))
  652                 ? $lowest_slot
  653                 : $MIN_HEIGHT * $FULL_SLOTS - 1;
  654         } else {
  655             $init_shift = ($lowest_slot > ($MAX_MULTI * $FULL_SLOTS))
  656                 ? $lowest_slot
  657                 : $MAX_MULTI * $FULL_SLOTS - 1;
  658         }
  659 
  660         $debug && abslog("init_shift = [$init_shift]");
  661         my $shift_slots = figure_shift(
  662             \@day_info,
  663             \@day_info_b,
  664             $lowest_slot,
  665             $init_shift,
  666             $numdays,
  667         );
  668         $debug && abslog("shift_slots = [$shift_slots]");
  669         #-------------------------------------
  670         # add b2t rects to the t2b rects with shift...
  671         #-------------------------------------
  672         foreach my $rect (@b_rects) {
  673             $rect->{start_slot}
  674                 = $shift_slots - $rect->{start_slot} - $rect->{num_slots} + 1;
  675             push(@rects, $rect);
  676         }
  677         #-------------------------------------
  678         # copy the type-coincidence info from the b2t day_info structure
  679         #-------------------------------------
  680         for(my $d = 1; $d <= $numdays; $d++) {
  681             push(@{ $day_info[$d]->{types} }, @{ $day_info_b[$d]->{types} });
  682         }
  683         $lowest_slot = $shift_slots;
  684     }
  685     
  686     #---------------------------------------------------------------
  687     # blocks
  688     # sort according to order in which blocks need to be drawn on image
  689     # and attempt to fit on object-row
  690     #---------------------------------------------------------------
  691 
  692     #--------------------------------------------------
  693     # first figure out where 
  694     #--------------------------------------------------
  695     my $last_slot;
  696     if ($VARIABLE_HEIGHT) {
  697         $last_slot = ($lowest_slot >= ($MIN_HEIGHT * $FULL_SLOTS))
  698             ? $lowest_slot
  699             : $MIN_HEIGHT * $FULL_SLOTS - 1;
  700     } else {
  701         $last_slot = ($lowest_slot >= ($MAX_MULTI * $FULL_SLOTS))
  702             ? $lowest_slot
  703             : $MAX_MULTI * $FULL_SLOTS - 1;
  704     }
  705 
  706     $debug && abslog("blocks: last-slot=[$last_slot]");
  707 
  708     my @block_info;
  709     foreach my $obj (sort {$b->{prio} <=> $a->{prio}} @block_unsorted) {
  710         #my ($rid, $start, $end, $type_id, $desc) = @{ $ojb->{res} };
  711         my ($start, $end) = (
  712             $obj->{mres}->{bounds}->{start},
  713             $obj->{mres}->{bounds}->{end},
  714         );
  715         my $type_id = $obj->{mres}->{res}->{type_id};
  716         for(my $day = $start; $day <= $end; $day++) {
  717             push(@{ $block_info[$day] }, [$type_id, $obj->{mres}->{res}->{id}]);
  718         }
  719         #---------------------------------------------------------
  720         # what's this prio thingy do?
  721         # since non-block reservations cannot overlap oneanother,
  722         # they are all assigned (above) the priority $NON_BLOCK_PRIO.
  723         # Later, just before the reservations are actually drawn, they 
  724         # are sorted in ascending order according to this priority.
  725         # thus, the negative block-types are at the top of the list,
  726         # then come the non-block types, then the block-types with
  727         # positive priority. As a list:
  728         #
  729         # Negative-priority block type: 0-9
  730         # Non-block type:               100     ($NON_BLOCK_PRIO)
  731         # Positive-priority block type: 101-110
  732         #---------------------------------------------------------
  733         my $prio = ($obj->{prio} >= 0)
  734             ? $obj->{prio} + $NON_BLOCK_PRIO
  735             : 10 + $obj->{prio};
  736         push(@rects, {
  737             prio        => $prio,
  738             mres        => $obj->{mres},
  739             start_slot  => 0,
  740             num_slots   => $last_slot + 1,
  741         });
  742     }
  743 
  744     #---------------------------------------------------------------
  745     # now I can check if there is invalid coincidence...
  746     #---------------------------------------------------------------
  747 
  748     my $error;
  749 
  750     # first check non-block reservations
  751     for(my $day = 1; $day <= $numdays; $day++) {
  752         exists($day_info[$day]->{types}) || next;
  753         for(my $i = 0; $i < $#{ $day_info[$day]->{types} }; $i++) {
  754             my $first = $day_info[$day]->{types}->[$i]->[0];
  755             for(my $j = $i+1; $j <= $#{ $day_info[$day]->{types} }; $j++) {
  756                 my $type_id = $day_info[$day]->{types}->[$j]->[0];
  757                 if (!AbsenceDB::resTypeCoincidenceAllowed($first, $type_id)) {
  758                     push(@{ $error },
  759                         {
  760                             type    => 'nb_coincidence',
  761                             date    => "$day.$month.$year",
  762                             ids     => [
  763                                 $day_info[$day]->{types}->[$i]->[1],
  764                                 $day_info[$day]->{types}->[$j]->[1],
  765                             ]
  766                         }
  767                     );
  768                 }
  769             }
  770         }
  771     }
  772     
  773     # then check block-type reservations
  774     for(my $day = 1; $day <= $numdays; $day++) {
  775         defined($block_info[$day]) || next;
  776         for(my $i = 0; $i < $#{ $block_info[$day] }; $i++) {
  777             my $first = $block_info[$day]->[$i]->[0];
  778             for(my $j = $i+1; $j <= $#{ $block_info[$day] }; $j++) {
  779                 my $type_id = $block_info[$day]->[$j]->[0];
  780                 if (!AbsenceDB::resTypeCoincidenceAllowed($first, $type_id)) {
  781                     push(@{ $error },
  782                         {
  783                             type    => 'b_coincidence',
  784                             date    => "$day.$month.$year",
  785                             ids     => [
  786                                 $block_info[$day]->[$i]->[1],
  787                                 $block_info[$day]->[$j]->[1],
  788                             ]
  789                         }
  790                     );
  791                 }
  792             }
  793         }
  794     }
  795 
  796     return {
  797         last_slot   => $last_slot,
  798         rects       => \@rects,
  799         error       => $error,
  800     };
  801 }
  802 
  803 sub figure_shift
  804 {
  805     my ($di_ref, $di_b_ref, $lowest_slot, $shift, $num_days) = @_;
  806 
  807     my $found = 0;
  808     OUTER: while(1) {
  809         for(my $slot = 0; $slot <= $lowest_slot; $slot++) {
  810             my $xform = $shift - $slot;
  811             for(my $day = 1; $day <= $num_days; $day++) {
  812                 if (defined($di_b_ref->[$day]->{slots}->[$slot]) &&
  813                     defined($di_ref->[$day]->{slots}->[$xform]))
  814                 {
  815                     next OUTER;
  816                 }
  817             }
  818         }
  819         last;
  820     } continue {
  821         $shift++;
  822     }
  823 
  824     return $shift;
  825 }
  826 
  827 
  828 sub sort_prio_groups
  829 {
  830     my ($lref, $arg) = @_;
  831 
  832     my $sort_sub = ($arg eq '-reverse')
  833         ? sub { $a <=> $b }
  834         : sub { $b <=> $a };
  835     
  836     my %prio_blocks;
  837     foreach my $bref (@{ $lref }) {
  838         push(@{ $prio_blocks{ $bref->{prio} } }, $bref);
  839     }
  840 
  841     my @out;
  842     foreach my $prio (sort $sort_sub keys(%prio_blocks)) {
  843         push(@out, sort_by_start_day($prio_blocks{$prio}));
  844     }
  845 
  846     return @out;
  847 }
  848 
  849 sub sort_by_start_day
  850 {
  851     my $lref = shift;
  852 
  853     my $sortfunc = sub {
  854         $a->{mres}->{bounds}->{start} <=> $b->{mres}->{bounds}->{start};
  855     };
  856 
  857     return [ sort $sortfunc @{ $lref } ];
  858 }
  859 
  860 sub by_start_day
  861 {
  862     return $a->{mres}->{bounds}->{start} <=> $b->{mres}->{bounds}->{start};
  863 }
  864 
  865 sub occupySlots
  866 {
  867     my ($starting_slot, $num_slots, $di_ref, $mres) = @_;
  868 
  869     #my ($rid, $start, $end, $type_id, $desc) = @$res;
  870     my ($start, $end, $type_id) = (
  871         $mres->{bounds}->{start},
  872         $mres->{bounds}->{end},
  873         $mres->{res}->{type_id},
  874     );
  875     #abslog("  occupySlots: start-slot=[$starting_slot], n_slots=[$num_slots], start=[$start], end=[$end], type_id=[$type_id]");
  876 
  877     for(my $day = $start; $day <= $end; $day++) {
  878         my $slot = $starting_slot;
  879         while($slot < ($starting_slot + $num_slots)) {
  880             defined($di_ref->[$day]->{slots}->[$slot])
  881                 && die "occupySlots: oops. day=[$day], slot=[$slot], contents=[".$di_ref->[$day]->{slots}->[$slot]."]";
  882             $di_ref->[$day]->{slots}->[$slot] = $type_id;
  883             #$di_ref->[$day]->{slots}->[$slot] = $mres;
  884             #abslog("    occupying day=[$day], slot=[$slot]");
  885             $slot++;
  886         }
  887         push(@{ $di_ref->[$day]->{types} }, [ $type_id, $mres->{res}->{id} ]);
  888     }
  889 }
  890 
  891 sub findFreeSlotsFromTop
  892 {
  893     my ($num_slots, $day_info_ref, $start, $end) = @_;
  894 
  895     my $found_free = 0;
  896     my $starting_slot;
  897     my $found = 0;
  898 
  899     my $slot = 0;
  900 
  901     OUTER:
  902     while(1) {
  903         if (!defined($starting_slot)) {
  904             $starting_slot = $slot;
  905             #abslog("  resetting starting_slot to [$slot]");
  906         }
  907         for(my $day = $start; $day <= $end; $day++) {
  908             if (defined($day_info_ref->[$day]->{slots}->[$slot])) {
  909                 #abslog("  hit occupied space at day=[$day], slot=[$slot]");
  910                 $found_free = 0;
  911                 $starting_slot = undef;
  912                 next OUTER;
  913             }
  914         }
  915         $found_free++;
  916         if ($found_free == $num_slots) {
  917             $found = 1;
  918             last;
  919         }
  920     } continue {
  921         $slot++;
  922     }
  923 
  924     #return $found ? $starting_slot : undef;
  925     # $found should contain something real no matter what...
  926     $found || die "this can't happen...";
  927     return $starting_slot;
  928 }
  929 
  930 sub currentMonth
  931 {
  932     my ($month, $year) = @_;
  933     my ($m, $y) = (localtime)[4,5];
  934     $m++;
  935     $y += 1900;
  936 
  937     #print "m=$m, month=$month, y=$y, year=$year<BR>\n";
  938     if (($y == $year) && ($m == $month)) { return 1; }
  939 
  940     return 0;
  941 }
  942 
  943 sub markCurrentDay
  944 {
  945     my ($im, $month, $year) = @_;
  946 
  947     my ($d) = (localtime)[3];
  948     if ($DEBUG) {
  949         abslog("--- CURRENT DAY START ---");
  950         abslog("current day-num = [$d]");
  951         abslog("localtime=".localtime());
  952         abslog("env:");
  953         foreach my $ev (keys(%ENV)) {
  954             abslog("$ev=[$ENV{$ev}]");
  955         }
  956         abslog("--- CURRENT DAY END ---");
  957     }
  958 
  959     my $style   = AbsenceConfig::fetch('curr_day_style');
  960     my $brow    = AbsenceConfig::fetch('curr_day_begin_row');
  961 
  962     if ($brow > 3) { $brow = 3; }
  963 
  964     my $x1 = $ROW_LABEL_WIDTH + ($d - 1) * $COL_WIDTH + 1;
  965     my $x2 = $ROW_LABEL_WIDTH + $d * $COL_WIDTH - 1;
  966     #my $y1 = $HEADER_LINES * $ROW_HEIGHT + 1;
  967     my $y1 = ($brow - 1) * $HEADER_ROW_HEIGHT + 1;
  968     my $y2 = $I_HEIGHT - 2;
  969 
  970     if ($style eq 'fill') {
  971         # fill column
  972         $im->filledRectangle($x1, $y1, $x2, $y2, $COLOR{currday});
  973     } else {
  974         # put frame around column...
  975         $im->rectangle($x1, $y1, $x2, $y2, $COLOR{currday});
  976         $im->rectangle($x1+1, $y1+1, $x2-1, $y2-1, $COLOR{currday});
  977     }
  978 }
  979 
  980 #---------------------------------------------------------------
  981 # findAbsence()
  982 #
  983 # is passed month, year, and (x,y) coordinates of click
  984 #
  985 # returns array of two elements.  The first can be 'none', 'absence',
  986 # 'holiday' or 'start'.  The second depends on the first.
  987 #
  988 # The values mean:
  989 # 'none'        user clicked on the first line (CW, or on the second
  990 #               line (month-day) but not on a holiday
  991 # 'absence'     user clicked on a marked absence
  992 # 'holiday'     user clicked on a month-day marked as holiday
  993 # 'start'       user clicked on a user-line not marked as absence
  994 #
  995 # The second element is:
  996 # 'none'        blank
  997 # 'absence'     the absence-ID
  998 # 'holiday'     returns ref to a holiday array in format:
  999 #               [<day>, <month>, <year>, <holiday-name>]
 1000 # 'start'       a reference to an array containing the person_id and date
 1001 #               corresponding to the click, in format
 1002 #               [<person_id>,<D>,<M>,<Y>]
 1003 #---------------------------------------------------------------
 1004 sub findAbsence
 1005 {
 1006     my ($month, $year, $gid, $x, $y) = @_;
 1007 
 1008     my $numdays = AbsenceDate::daysInMonth($month, $year);
 1009     my $sav = $HEADER_LINES * $HEADER_ROW_HEIGHT;
 1010 
 1011     # sanity check
 1012     if ($x < $ROW_LABEL_WIDTH) {
 1013         return (none => '');
 1014     }
 1015 
 1016     # check if click in padding
 1017     if ($x > ($ROW_LABEL_WIDTH + $numdays * $COL_WIDTH)) {
 1018         return (none => 'stop-that');
 1019     }
 1020 
 1021     # get row number from y-coord
 1022     my $row = int($y/$ROW_HEIGHT);      # returns row 0-n
 1023 
 1024     if ($row == 1) {
 1025         # month-day row
 1026         my $hol = findHoliday($month, $year, $x);
 1027         if (defined($hol)) {
 1028             return (holiday => $hol);
 1029         }
 1030         return (none => 'no-holiday');
 1031     }
 1032 
 1033     # at this point, coordinates must be in a person row
 1034     if ($y <= $sav) {
 1035         return (none => '');
 1036     }
 1037 
 1038     # get people
 1039     my @people = AbsenceDB::getPeople($gid);
 1040     my $person_id = $people[$row - $HEADER_LINES];
 1041 
 1042     my ($start, $end, $short_desc, $x1, $x2);
 1043 
 1044     # go through absences
 1045     my $rid;
 1046     $DEBUG && print "finding absence: $month/$year, ($x,$y)..\n";
 1047     my @res_list = AbsenceDB::getMonthReservations($person_id, $month, $year);
 1048     foreach my $res (@res_list) {
 1049         ($rid, $start, $end, $short_desc) = @$res;
 1050         $x1 = $ROW_LABEL_WIDTH + ($start - 1) * $COL_WIDTH + 1;
 1051         $x2 = $ROW_LABEL_WIDTH + $end * $COL_WIDTH - 1;
 1052         $DEBUG && print "checking id=$rid, x1=$x1, x2=$x2...\n";
 1053         if (($x >= $x1) && ($x < $x2)) {
 1054             return (absence => $rid);
 1055         }
 1056     }
 1057 
 1058     # must be a click on a person-row but not on absence...
 1059     # figure out date
 1060 
 1061     $x -= $ROW_LABEL_WIDTH;
 1062     my $day = int($x/$COL_WIDTH) + 1;
 1063     return (start => [$person_id, $day, $month, $year]);
 1064 }
 1065 
 1066 sub markWeekends
 1067 {
 1068     my ($im, $month, $year) = @_;
 1069 
 1070     my $numdays = AbsenceDate::daysInMonth($month, $year);
 1071 
 1072     my ($x1, $y1, $x2, $y2, $start, $end);
 1073 
 1074     $y1 = 0;
 1075     $y2 = $I_HEIGHT;
 1076 
 1077     my $we_color = $COLOR{we};
 1078     if ($MARK_CM && currentMonth($month, $year)) {
 1079         $we_color = $COLOR{cm_we};
 1080     }
 1081 
 1082     # find first sat/sun
 1083     my $i = 1;
 1084     my $wd;
 1085     while(($wd = AbsenceDate::weekDayFromDate($i, $month, $year)) % 6 != 0) {
 1086         $i++;
 1087     }
 1088     $start = $i;
 1089     $end = ($wd == 6) ? $i + 1 : $i;
 1090 
 1091     do {
 1092         $x1 = $ROW_LABEL_WIDTH + ($start - 1) * $COL_WIDTH + 1;
 1093         $x2 = $ROW_LABEL_WIDTH + $end * $COL_WIDTH - 1;
 1094         $im->filledRectangle($x1, $y1, $x2, $y2, $we_color);
 1095         $start = $end + 6;
 1096         $end = (($start + 1) <= $numdays) ? $start + 1 : $start;
 1097     } while($start <= $numdays);
 1098 }
 1099 
 1100 sub findHoliday
 1101 {
 1102     my ($month, $year, $x) = @_;
 1103 
 1104     my $numdays = AbsenceDate::daysInMonth($month, $year);
 1105     #my @holidays = AbsenceHolidays::getList($month, $year);
 1106     my @holidays = AbsenceDB::getHolidayList($month, $year);
 1107 
 1108     if (!@holidays) { return undef; }
 1109 
 1110     my ($x1, $x2);
 1111 
 1112     my $i;
 1113     for($i = 1; $i <= $numdays; $i++) {
 1114         if ($i == $holidays[0]->[0]) {
 1115             $x1 = $ROW_LABEL_WIDTH + ($i - 1) * $COL_WIDTH + 1;
 1116             $x2 = $ROW_LABEL_WIDTH + $i * $COL_WIDTH - 1;
 1117             if (($x >= $x1) && ($x <= $x2)) {
 1118                 $holidays[0]->[2] = $year;
 1119                 return $holidays[0];
 1120             }
 1121             shift(@holidays);
 1122             if (!@holidays) { last; }
 1123         }
 1124     }
 1125 
 1126     return undef;
 1127 }
 1128 
 1129 sub markHeaderHolidays
 1130 {
 1131     my ($im, $month, $year, $map_fh) = @_;
 1132 
 1133     $HOLIDAY_SCHEME eq 'advanced' && !$HOL_SHOW_HEAD && return;
 1134 
 1135     my $numdays = AbsenceDate::daysInMonth($month, $year);
 1136 
 1137     my @params;
 1138     my ($country_id, $region_id);
 1139 
 1140     if ($HOLIDAY_SCHEME eq 'advanced') {
 1141         if (defined($HOL_HEAD_COUNTRY)) {
 1142             $country_id = AbsenceDB::getCountryId(code => $HOL_HEAD_COUNTRY);
 1143             if (defined($country_id)) {
 1144                 push(@params, country => $country_id);
 1145             }
 1146         }
 1147         if (defined($HOL_HEAD_REGION)) {
 1148             $region_id = AbsenceDB::getRegionId($HOL_HEAD_REGION);
 1149             if (defined($region_id)) {
 1150                 push(@params, region => $region_id);
 1151             }
 1152         }
 1153     }
 1154 
 1155     $HDEBUG && abslog("params=[".join(',', @params)."]");
 1156     my @holidays = AbsenceDB::getHolidayList($month, $year, @params);
 1157     $HDEBUG && abslog("got [".scalar(@holidays)."] holidays");
 1158 
 1159     if (!@holidays) { return; }
 1160 
 1161     my ($y1, $y2, $start, $end);
 1162 
 1163     $y1 = $HEADER_ROW_HEIGHT;
 1164     if ($HOLIDAY_MARK eq 'small' || $HOLIDAY_SCHEME eq 'advanced') {
 1165         $y2 = $HEADER_LINES * $HEADER_ROW_HEIGHT;
 1166     } else {
 1167         $y2 = $I_HEIGHT - 1;
 1168     }
 1169 
 1170     my $map_y2 = $HEADER_LINES * $HEADER_ROW_HEIGHT;
 1171     my $map = drawHolidays($im, \@holidays, $y1, $y2, $map_y2, $numdays);
 1172     print $map_fh $map;
 1173 }
 1174 
 1175 sub drawHolidays
 1176 {
 1177     my ($im, $hol_ref, $y1, $y2, $map_y2, $numdays) = @_;
 1178 
 1179     my ($i, $x1, $x2);
 1180     my $map = '';
 1181 
 1182     for($i = 1; $i <= $numdays && @{ $hol_ref }; $i++) {
 1183         if ($i == $hol_ref->[0]->[0]) {
 1184             $x1 = $ROW_LABEL_WIDTH + ($i - 1) * $COL_WIDTH + 1;
 1185             $x2 = $ROW_LABEL_WIDTH + $i * $COL_WIDTH - 1;
 1186             $im->filledRectangle($x1, $y1, $x2, $y2, $COLOR{bholiday});
 1187             $map .= qq[<AREA SHAPE="rect" COORDS="$x1,$y1,$x2,$map_y2" NOHREF TITLE="$hol_ref->[0]->[3]">\n];
 1188             shift(@{ $hol_ref });
 1189         }
 1190     }
 1191 
 1192     return $map;
 1193 }
 1194 
 1195 sub allocateColors
 1196 {
 1197     my $im = shift;
 1198 
 1199     my @types = AbsenceDB::getTypes('all');
 1200 
 1201     # allocate colors
 1202     
 1203     # background must be allocated first...
 1204     $COLOR{bg} = $im->colorAllocate(@{$COLOR_VALUES{bg}});
 1205 
 1206     foreach my $col (keys(%COLOR_VALUES)) {
 1207         if ($col eq 'bg') { next; }
 1208         #print "COL[$col]: [".join(',', @{$COLOR_VALUES{$col}}),"]<BR>\n";
 1209         $COLOR{$col} = $im->colorAllocate(@{$COLOR_VALUES{$col}});
 1210         #$HUHU{$col} = (MAX(@{$COLOR_VALUES{$col}}) < 128) ? 1 : 0;
 1211     }
 1212 
 1213     foreach my $type_ref (@types) {
 1214         my $trans = defined($type_ref->{transparency})
 1215             ? int((127 * $type_ref->{transparency}) / 100)
 1216             : 0;
 1217         $COLOR{ $type_ref->{id} } = $im->colorAllocateAlpha(
 1218             $type_ref->{color_red},
 1219             $type_ref->{color_green},
 1220             $type_ref->{color_blue},
 1221             $trans
 1222         );
 1223         #$HUHU{$type} = (MAX(@{$types->{$type}}) < 128) ? 1 : 0;
 1224     }
 1225 }
 1226 
 1227 #void RGBtoHSV( float r, float g, float b, float *h, float *s, float *v )
 1228 sub RGBtoHSV
 1229 {
 1230     my ($r, $g, $b) = @_;
 1231 
 1232     my ($min, $max, $h, $s, $v);
 1233 
 1234     #float min, max, delta;
 1235 
 1236     $min = MIN($r, $g, $b);
 1237     $max = MAX($r, $g, $b);
 1238     $v = $max;                          # v
 1239 
 1240     my $delta = $max - $min;
 1241 
 1242     if ($max != 0) {
 1243         $s = $delta / $max;             # s
 1244     } else {
 1245         # r = g = b = 0                 # s = 0, v is undefined
 1246         $s = 0;
 1247         $h = -1;
 1248         return($h, $s, $v);
 1249     }
 1250 
 1251     if ($r == $max ) {
 1252         $h = ($g - $b) / $delta;        # between yellow & magenta
 1253     } elsif ($g == $max) {
 1254         $h = 2 + ($b - $r) / $delta;    # between cyan & yellow
 1255     } else {
 1256         $h = 4 + ($r - $g) / $delta;    # between magenta & cyan
 1257     }
 1258 
 1259     $h *= 60;                           # degrees
 1260     if ($h < 0) {
 1261         $h += 360;
 1262     }
 1263 
 1264     ($h, $s, $v);
 1265 }
 1266 
 1267 sub MIN
 1268 {
 1269     my $min = 99999999;
 1270     foreach (@_) {
 1271         if ($_ < $min) { $min = $_; }
 1272     }
 1273 
 1274     $min;
 1275 }
 1276 
 1277 sub MAX
 1278 {
 1279     my $max = 0;
 1280     foreach (@_) {
 1281         if ($_ > $max) { $max = $_; }
 1282     }
 1283 
 1284     $max;
 1285 }
 1286 
 1287 sub drawCwBars
 1288 {
 1289     my ($image, $month, $year) = @_;
 1290 
 1291     my $monthdays = AbsenceDate::daysInMonth($month, $year);
 1292     my ($cw, $cy, $x1, $y1, $x2, $y2);
 1293 
 1294     my $wd;
 1295     my $day = 1;
 1296     while(
 1297         (($wd = AbsenceDate::weekDayFromDate($day, $month, $year)) == 0) ||
 1298         ($wd == 6)
 1299     )
 1300     {
 1301         $day++;
 1302     }
 1303     $DEBUG && print "day = $day\n";
 1304 
 1305     my $cw_color = $COLOR{cw};
 1306     if ($MARK_CM && currentMonth($month, $year)) {
 1307         $cw_color = $COLOR{cm_cw};
 1308     }
 1309 
 1310     # $day is first monday - friday
 1311     while($day <= $monthdays) {
 1312         $x1 = $ROW_LABEL_WIDTH + ($day - 1) * $COL_WIDTH + 1;
 1313         $y1 = 1;
 1314         my $end;
 1315         if (($day > 1) || ($wd == 1)) {
 1316             $end = (($day + 4) <= $monthdays)
 1317                 ? 4
 1318                 : $monthdays - $day;
 1319         } else {
 1320             $end = 5 - $wd;
 1321         }
 1322         $x2 = $ROW_LABEL_WIDTH + ($day + $end) * $COL_WIDTH - 1;
 1323         $y2 = $HEADER_ROW_HEIGHT - 1;
 1324         $image->filledRectangle($x1, $y1, $x2, $y2, $cw_color);
 1325         if ($end == 0) {
 1326             # if CW-bar is only one day long, no room for CW-label
 1327             $day += 3 + $end;
 1328             $wd = 0;
 1329             next;
 1330         }
 1331         ($cw, $cy) = AbsenceDate::calendarWeek(
 1332             {
 1333                 day     => $day,
 1334                 month   => $month,
 1335                 year    => $year,
 1336             }
 1337         );
 1338         my $mid = int(($x2 - $x1)/2);
 1339         $image->string(gdSmallFont,
 1340             $x1 + $mid - 13,
 1341             3,
 1342             "CW $cw",
 1343             $COLOR{text_dark});
 1344         if ($wd) {
 1345             $day += 8 - $wd;
 1346             $wd = 0;
 1347         } else {
 1348             $day += 7;
 1349         }
 1350     }
 1351 }
 1352 
 1353 #---------------------------------------------------------------
 1354 # drawReservation()
 1355 #
 1356 # marks a reservation (absence).  If the skipping of weekends
 1357 # and holidays has been configured, findBlocks() is called to
 1358 # find valid blocks, i.e., sub-parts of reservation, that can be
 1359 # marked (weekdays without holidays).
 1360 #---------------------------------------------------------------
 1361 sub drawReservation
 1362 {
 1363     #my ($im, $y_offset, $start, $end, $type_id, $desc, $rid, $month, $year) = @_;
 1364     #my ($im, $y_offset, $ref, $month, $year) = @_;
 1365     my ($im, $y_bounds, $ref, $month, $year) = @_;
 1366 
 1367     my ($type_id, $desc, $rid, $start, $end) = (
 1368         $ref->{res}->{type_id},
 1369         $ref->{res}->{description},
 1370         $ref->{res}->{id},
 1371         $ref->{bounds}->{start},
 1372         $ref->{bounds}->{end},
 1373     );
 1374 
 1375     my $type_ref = AbsenceDB::getType($type_id);
 1376     defined($type_ref) || die "type_id [$ref->{res}->{id}] not found";
 1377 
 1378     $DEBUG && abslog("SKIP_WE_HOL=[$SKIP_WE_HOL]");
 1379 
 1380     # call the regular unless skipping desired
 1381     if (!$SKIP_WE_HOL && !$type_ref->{skip_non_workdays}) {
 1382         _drawReservation($im, $y_bounds, $start, $end, $type_ref, $desc, $rid);
 1383         return;
 1384     }
 1385 
 1386     my $i = $start;
 1387 
 1388     #$DEBUG && abslog("\nstart=$ref->{bounds}->{start}, end=$ref->{bounds}->{end}, mon=$month, year=$year, rid=$ref->{res}->{id}");
 1389 
 1390     my ($blocksref, $invalref) = findBlocks($ref->{bounds}, $month, $year);
 1391     foreach my $blk (@{$blocksref}) {
 1392         _drawReservation($im, $y_bounds, $blk->[0], $blk->[1], $type_ref, $desc, $rid);
 1393     }
 1394 
 1395     $SKIP_MARK_SK || return;
 1396 
 1397     foreach my $day (@{$invalref}) {
 1398         #markInvalid($im, $y_offset, $day, $type_id);
 1399         markInvalid($im, $y_bounds, $day, $type_id);
 1400     }
 1401 }
 1402 
 1403 #---------------------------------------------------------------
 1404 # findBlocks()
 1405 #
 1406 # find sub-day-ranges within a day-range that consist only of
 1407 # weekdays that are not holidays.
 1408 #
 1409 # returns references to two arrays:
 1410 #
 1411 # 1: an array of references to arrays of the form (start, end):
 1412 # ([startday1, endday1], [startday2, endday2], [startdayN, enddayN])
 1413 #
 1414 # 2: an array of days that have been skipped
 1415 #---------------------------------------------------------------
 1416 sub findBlocks
 1417 {
 1418     my ($bounds, $month, $year) = @_;
 1419 
 1420     #my @holidays = AbsenceHolidays::getList($month, $year);
 1421     my @holidays = AbsenceDB::getHolidayList($month, $year);
 1422     my %hols = map { $_->[0], 1} @holidays;
 1423 
 1424     my ($want, $s, @blocks, @invalid);
 1425 
 1426     my $day = $bounds->{start};
 1427 
 1428     my $in_block = 0;
 1429     my $last;
 1430     while($day <= $bounds->{end}) {
 1431         $want = (AbsenceDate::weekDayFromDate($day, $month, $year) % 6 != 0)
 1432             && !exists($hols{$day});
 1433         if ($in_block && !$want) {
 1434             push(@blocks, [$s, $last]);
 1435             #abslog("pushing block: $s -> $last");
 1436             $in_block = 0;
 1437             push(@invalid, $day);
 1438         } elsif (!$in_block && $want) {
 1439             $in_block = 1;
 1440             $s = $day;
 1441         } elsif (!$in_block) {
 1442             push(@invalid, $day);
 1443         }
 1444         $last = $day;
 1445         $day++;
 1446     }
 1447 
 1448     if ($in_block) {
 1449         push(@blocks, [$s, $bounds->{end}]);
 1450         #abslog("pushing block: $s -> $bounds->{end}");
 1451     }
 1452 
 1453     return (\@blocks, \@invalid);
 1454 }
 1455 
 1456 #------------------------------------------------------------------
 1457 # drawReservation()
 1458 #
 1459 # $start and $end are the month-day numbers within the month in
 1460 # question
 1461 #------------------------------------------------------------------
 1462 sub _drawReservation
 1463 {
 1464     my ($im, $y_bounds, $start, $end, $type_ref, $desc, $rid) = @_;
 1465 
 1466     my $type_id = $type_ref->{id};
 1467 
 1468     #abslog("_addRes: rid=$rid, start=$start, end=$end");
 1469     my ($x1, $x2);
 1470     my ($y1, $y2) = @{ $y_bounds };
 1471     $x1 = $ROW_LABEL_WIDTH + ($start - 1) * $COL_WIDTH + 1;
 1472     #$y1 = $y_offset + 1;
 1473     $x2 = $ROW_LABEL_WIDTH + $end * $COL_WIDTH - 1;
 1474     #$y2 = $y_offset + $ROW_HEIGHT - 1;
 1475 
 1476     $DEBUG && print "  ABS: ($x1, $y1), ($x2, $y2) - $type_id, ID=$rid\n";
 1477 
 1478     $im->filledRectangle($x1, $y1, $x2, $y2, $COLOR{$type_id});
 1479     
 1480     if ($MULTI_RES && (($y2 - $y1) > 3)) {
 1481         # draw frame around rectangle to differentiate it from neighbor
 1482         $im->rectangle($x1, $y1, $x2, $y2, $COLOR{res_border});
 1483     }
 1484 
 1485     #-----------------------------------------------------------------
 1486     # experience shows that approximately 3 characters in the chosen
 1487     # label font fit in a column of width 20 ($COL_WIDTH). Yeah, it's
 1488     # a hack.
 1489     #-----------------------------------------------------------------
 1490 
 1491     # if not enough space for text, return
 1492     (($y2 - $y1) < 11) && return;
 1493 
 1494     # if no description present, return
 1495     (!defined($desc) || length($desc) == 0) && return;
 1496 
 1497     my $num_days = $end - $start + 1;
 1498     my $mid = int(($x2 - $x1)/2);
 1499 
 1500     my ($half, $lab_xpos);
 1501 
 1502     # need to call from_to() before "substr()" is called so that the string
 1503     # is chopped at proper character boundaries and not at octets
 1504 
 1505     $DEBUG && abslog("length of desc before conversion: ".length($desc));
 1506     from_to($desc, 'utf8', 'iso-8859-1') || die "from_to failed: $!";
 1507     $DEBUG && abslog("length of desc after conversion: ".length($desc));
 1508 
 1509     if (int((length($desc)+2)*20/3) >= $num_days * $COL_WIDTH) {
 1510         $lab_xpos = $x1 + 2;
 1511         my $trim_len = ($num_days * $COL_WIDTH * 3)/20;
 1512         $DEBUG && abslog("trim-len=[$trim_len]");
 1513         $desc = substr($desc, 0, $trim_len);
 1514     } else {
 1515         $half = int(length($desc)/6.0 * $COL_WIDTH);
 1516         $lab_xpos = $x1 + $mid - $half;
 1517     }
 1518 
 1519     #my $offset = $MULTI_RES ? ($y2 - $y1)/2 - 7;
 1520     my $offset = int(($y2 - $y1)/2) - 6;
 1521 
 1522     my $color = determineLabelColor(
 1523         $type_ref->{color_red},
 1524         $type_ref->{color_green},
 1525         $type_ref->{color_blue},
 1526     );
 1527 
 1528     $im->string(gdSmallFont,
 1529         $lab_xpos,
 1530         $y1 + $offset,
 1531         $desc,
 1532         $COLOR{$color});
 1533 }
 1534 
 1535 sub determineLabelColor
 1536 {
 1537     my ($r, $g, $b) = @_;
 1538     #if (0.212671 * ($r/255) + 0.715160 * ($g/255) + 0.072169 * ($b/255) > 0.5) {
 1539     if (0.212671 * $r + 0.715160 * $g + 0.072169 * $b < 127.5) {
 1540         return 'white';
 1541     }
 1542     return 'black';
 1543 }
 1544 
 1545 sub markInvalid
 1546 {
 1547     #my ($im, $y_offset, $day, $type_id) = @_;
 1548     my ($im, $y_bounds, $day, $type_id) = @_;
 1549 
 1550     my ($x1, $x2);
 1551     #my ($y1, $y2) = @{ $y_bounds };
 1552     $x1 = $ROW_LABEL_WIDTH + ($day - 1) * $COL_WIDTH + 1;
 1553     #$y1 = $y_offset + 1;
 1554     $x2 = $ROW_LABEL_WIDTH + $day * $COL_WIDTH - 1;
 1555     #$y2 = $y_offset + $ROW_HEIGHT - 1;
 1556 
 1557     $im->rectangle($x1, $y_bounds->[0], $x2, $y_bounds->[1], $COLOR{$type_id});
 1558 }
 1559 
 1560 sub legendFilePath
 1561 {
 1562     my $it = AbsenceConfig::fetch('image_type');
 1563     my $legend_abs = "$IMAGE_DIR_ABS/legend.$it";
 1564     my $legend_rel = "$IMAGE_DIR_REL/legend.$it";
 1565 
 1566     return ($legend_rel, $legend_abs);
 1567 }
 1568 
 1569 sub removeLegendFile
 1570 {
 1571     my $abs = (legendFilePath())[1];
 1572     $DEBUG && abslog("removing legend file [$abs]");
 1573     unlink($abs) || abslog("error unlinking legend file [$abs]: $!");
 1574 }
 1575 
 1576 sub makeLegend
 1577 {
 1578     #my $outfile = shift;
 1579     my $outfile = (legendFilePath())[1];
 1580 
 1581     my $type;
 1582     my $tag_width;
 1583     my $hl_tmp = AbsenceConfig::fetch('holiday_label');
 1584     my $hl_convtest = $hl_tmp;
 1585 
 1586     # worry about encoding of holiday-label
 1587     my $holiday_label;
 1588     eval {
 1589         $holiday_label = decode('utf8', $hl_convtest, 1);
 1590     };
 1591     if ($@) {
 1592         # decode() failed, so assume charset=Latin1
 1593         $holiday_label = decode('iso-8859-1', $hl_tmp);
 1594     }
 1595     
 1596     my $style = AbsenceConfig::fetch('legend_style');
 1597     if ($style =~ /^constant:(\d+)$/) {
 1598         $tag_width = $1;
 1599         $style = 'constant';
 1600     } elsif ($style ne 'fit') {
 1601         die "unrecognized legend-style [$style]";
 1602     }
 1603 
 1604     my $legend_mtime;
 1605     # check if legend needs to be produced.
 1606     if (-e $outfile) {
 1607         #my $type_mtime = AbsenceTypes::modTime();
 1608         my $type_mtime = AbsenceDB::getTypeModTime();
 1609         my $legend_mtime = (stat($outfile))[9];
 1610         $DEBUG && abslog("type_mtime=[$type_mtime], legend_mtime=[$legend_mtime]");
 1611         if ($type_mtime < $legend_mtime) {
 1612             # print "OLDER.<BR>\n";
 1613             # print "type file OLDER than legend.<BR>\n";
 1614             return $legend_mtime;
 1615         }
 1616         # younger
 1617         # print "type file YOUNGER than legend.<BR>\n";
 1618 
 1619         # if the legend has changed, all month-images must be deleted
 1620         abslog("removing month images (makeLegend)");
 1621         removeMonthImages();
 1622     }
 1623 
 1624     my @types = AbsenceDB::getTypes();
 1625     my $num_types = scalar(@types) + 1;
 1626 
 1627     my $tag_sep = 20;
 1628     my $i_width = 60;
 1629     my ($top_width, $bottom_width, $block_width);
 1630     my (@full, @block, @short);
 1631     my $label;
 1632     my $col_id;
 1633     my @other;
 1634     my $height;
 1635     my $name;
 1636 
 1637     foreach $type (@types) {
 1638         $name = decode_utf8($type->{name});
 1639         my $w = ($style eq 'constant')
 1640             ? $tag_width
 1641             : length($name) * 6 + 5;
 1642         my $height = defined($type->{height}) ? $type->{height} : 'full';
 1643         $DEBUG && abslog("type name=[$name], height=[$height]");
 1644         if (!$MULTI_RES || ($height eq 'full')) {
 1645             push(@full, [$type, $name, $w]);
 1646             $top_width += $w + $tag_sep;
 1647         } elsif ($height eq 'block') {
 1648             push(@block, [$type, $name, $w]);
 1649             $block_width += $w + $tag_sep;
 1650         } else {
 1651             push(@other, [$type, $name, $w, $height]);
 1652             $bottom_width += $w + $tag_sep;
 1653         }
 1654     }
 1655 
 1656     my $w = ($style eq 'constant')
 1657         ? $tag_width
 1658         : (length($holiday_label) * 6 + 5);
 1659 
 1660     $top_width += $w + $tag_sep;
 1661     @full = sort { lc($a->[1]) cmp lc($b->[1]) } @full;
 1662     push(@full, [ 'bholiday', $holiday_label, $w ]);
 1663 
 1664     @block = sort { lc($a->[1]) cmp lc($b->[1]) } @block;
 1665     @other = sort { lc($a->[1]) cmp lc($b->[1]) } @other;
 1666 
 1667     my $i_height = ($MULTI_RES && (@block || @other)) ? 60 : 25;
 1668     $i_width += ($top_width > $bottom_width) ? $top_width : $bottom_width;
 1669     my $block_start = $i_width;
 1670     $i_width += $block_width;
 1671 
 1672     my $im = new GD::Image($i_width, $i_height);
 1673 
 1674     allocateColors($im);
 1675 
 1676     # do background
 1677     # I don't need to do this.  Because the background color
 1678     # is allocated first (in "allocateColors()"), GD automagically
 1679     # uses it for the background
 1680     #$im->filledRectangle(0, 0, $i_width, $i_height, $COLOR{bg});
 1681 
 1682     $im->string(gdSmallFont,
 1683         2, 5,
 1684         'Legend:',
 1685         $COLOR{text_dark});
 1686 
 1687     my $x = 60;
 1688 
 1689     my $width;
 1690     foreach my $ref (@full) {
 1691         ($type, $label, $width) = @$ref;
 1692         $col_id = ref($type) ? $type->{id} : $type;
 1693         $im->filledRectangle($x, 4, $x+$width, 21, $COLOR{$col_id});
 1694         #from_to($label, 'utf8', 'iso-8859-1') || die "from_to failed: $!";
 1695         $label = encode('iso-8859-1', $label);
 1696         drawLegendLabel($im, $type, $label, $x+2, 6);
 1697         $x += $width + $tag_sep;
 1698     }
 1699 
 1700     if ($MULTI_RES) {
 1701         $x = 60;
 1702         my $base_y = 30;
 1703 
 1704         foreach my $ref (@other) {
 1705             ($type, $label, $width, $height) = @$ref;
 1706             $col_id = $type->{id};
 1707             $im->rectangle($x, $base_y, $x+$width, $base_y + 25, $COLOR{text_dark});
 1708             my $pix_h = ($height eq 'half')
 1709                 ? 2 * $SLOT_PIXELS
 1710                 : $SLOT_PIXELS;
 1711             $im->filledRectangle($x+2, $base_y + 3, $x+$width - 2, $base_y + 3 + $pix_h, $COLOR{$col_id});
 1712             #from_to($label, 'utf8', 'iso-8859-1') || die "from_to failed: $!";
 1713             $label = encode('iso-8859-1', $label);
 1714             $im->string(gdSmallFont,
 1715                 $x+2, $base_y + 10,
 1716                 $label,
 1717                 $COLOR{text_dark});
 1718             $x += $width + $tag_sep;
 1719         }
 1720 
 1721         $x = $block_start;
 1722         foreach my $ref (@block) {
 1723             ($type, $label, $width) = @$ref;
 1724             my $col_id = $type->{id};
 1725             $im->filledRectangle($x, 4, $x+$width, 50, $COLOR{$col_id});
 1726             $im->rectangle($x, 4, $x+$width, 50, $COLOR{text_dark});
 1727             #from_to($label, 'utf8', 'iso-8859-1') || die "from_to failed: $!";
 1728             $label = encode('iso-8859-1', $label);
 1729             drawLegendLabel($im, $type, $label, $x+2, 20);
 1730             $x += $width + $tag_sep;
 1731         }
 1732     }
 1733 
 1734     my $fh = FileHandle->new($outfile, 'w');
 1735     defined($fh) || die "open $outfile for writing";
 1736     binmode($fh);   # stoopid windoze
 1737     my $it = AbsenceConfig::fetch('image_type');
 1738     if ($it eq 'png') {
 1739         print $fh $im->png;
 1740     } elsif ($it eq 'gif') {
 1741         print $fh $im->gif;
 1742     } elsif ($it eq 'jpg') {
 1743         print $fh $im->jpg;
 1744     } else {
 1745         die "unknown image_type [$it]";
 1746     }
 1747     close($fh);
 1748 
 1749     return time();
 1750 }
 1751 
 1752 sub drawLegendLabel
 1753 {
 1754     my ($im, $type, $label, $x, $y) = @_;
 1755 
 1756     my $color;
 1757     if (ref($type)) {
 1758         $color = determineLabelColor(
 1759             $type->{color_red},
 1760             $type->{color_green},
 1761             $type->{color_blue},
 1762         );
 1763     } else {
 1764         $color = determineLabelColor(@{ $COLOR_VALUES{bholiday} });
 1765     }
 1766 
 1767     $im->string(gdSmallFont,
 1768         $x, $y,
 1769         $label,
 1770         $COLOR{$color});
 1771 }
 1772 
 1773 sub writeObjectRowMapAreas
 1774 {
 1775     my ($pid, $gid, $month, $year, $cur_y, $map_fh) = @_;
 1776 
 1777     my ($x1, $y1, $x2, $y2, $start, $end);
 1778 
 1779     my $rid;
 1780     my $title;
 1781     my $target;
 1782     my $inst;
 1783 
 1784     my $numdays = AbsenceDate::daysInMonth($month, $year);
 1785 
 1786     $y1 = $cur_y + 1;
 1787     $y2 = $cur_y + $ROW_HEIGHT - 1;
 1788     my $read_only = 0;
 1789 
 1790     my $p = AbsenceDB::getPerson($pid, 'name');
 1791     
 1792     #print "<!-- checking absences for $p, person_id [$pid] -->\n";
 1793     print $map_fh "<!-- start person_id=[$pid] -->\n";
 1794 
 1795     $DEBUG && print "getting month absences for $p, person_id [$pid]\n";
 1796     my @res_list = AbsenceDB::getMonthReservations($pid, $month, $year);
 1797     #my @sorted = sort {$a->[1] <=> $b->[1]} @res_list;
 1798     my @sorted = sort { $a->{bounds}->{start} <=> $b->{bounds}->{start} } @res_list;
 1799 
 1800     #---------------------------------------------------------------
 1801     # if $read_only evaluates to 'true', a client-map will be
 1802     # produced with no clickable areas
 1803     #---------------------------------------------------------------
 1804     if ($read_only) {
 1805         foreach my $res (@sorted) {
 1806             my $desc = $res->{res}->{description};
 1807             my ($start, $end) = ($res->{bounds}->{start},$res->{bounds}->{end});
 1808             $x1 = $ROW_LABEL_WIDTH + ($start - 1) * $COL_WIDTH + 1;
 1809             $x2 = $ROW_LABEL_WIDTH + $end * $COL_WIDTH - 1;
 1810             $title = qq{TITLE="$desc"};
 1811             print $map_fh qq[<AREA SHAPE="rect" COORDS="$x1,$y1,$x2,$y2" NOHREF $title>\n];
 1812         }
 1813         $cur_y += $ROW_HEIGHT;
 1814         next;
 1815     }
 1816 
 1817     my $day = 1;
 1818     while($day <= $numdays) {
 1819         $x1 = $ROW_LABEL_WIDTH + ($day - 1) * $COL_WIDTH + 1;
 1820         if (@sorted && ($sorted[0]->{bounds}->{start} == $day)) {
 1821             my $desc = $sorted[0]->{res}->{description};
 1822             my $rid = $sorted[0]->{res}->{id};
 1823             my ($start, $end) = (
 1824                 $sorted[0]->{bounds}->{start},
 1825                 $sorted[0]->{bounds}->{end},
 1826             );
 1827             $x2 = $ROW_LABEL_WIDTH + $end * $COL_WIDTH - 1;
 1828             $title = qq{TITLE="$desc"};
 1829             $target = "res,$rid";
 1830             shift(@sorted);
 1831             $day = $end + 1;
 1832         } else {
 1833             $x2 = $ROW_LABEL_WIDTH + $day * $COL_WIDTH - 1;
 1834             $title = '';
 1835             $target = "new,$pid,$gid,$day,$month,$year";
 1836             $day++;
 1837         }
 1838         $target = qq[HREF="$CGI_DIR/absence-click.pl$inst?$target"];
 1839         print $map_fh qq[<AREA SHAPE="rect" COORDS="$x1,$y1,$x2,$y2" $target $title>\n];
 1840     }
 1841     print $map_fh "<!-- end person_id=[$pid] -->\n";
 1842 }
 1843 
 1844 sub writeMultiMapAreas
 1845 {
 1846     my ($pid, $gid, $y_bounds, $month, $year, $rects_ref, $map_fh) = @_;
 1847 
 1848     my ($x1, $y1, $x2, $y2);
 1849     my ($sd, $ed, $rid, $desc, $target, $title);
 1850     my $inst;
 1851 
 1852     #-----------------------------------------------------------------
 1853     # sort the reservations rectangles by descending priority
 1854     #-----------------------------------------------------------------
 1855     foreach my $rect (sort {$b->{prio} <=> $a->{prio}} @{ $rects_ref }) {
 1856         $sd = $rect->{mres}->{bounds}->{start};
 1857         $ed = $rect->{mres}->{bounds}->{end};
 1858         $x1 = $ROW_LABEL_WIDTH + ($sd - 1) * $COL_WIDTH + 1;
 1859         $x2 = $ROW_LABEL_WIDTH + $ed * $COL_WIDTH - 1;
 1860         ($y1, $y2) = @{ $rect->{y_bounds} };
 1861         $rid = $rect->{mres}->{res}->{id};
 1862         $desc = $rect->{mres}->{res}->{description};
 1863         $target = qq{HREF="$CGI_DIR/absence-click.pl$inst?res,$rid"};
 1864         $title = qq{TITLE="$desc"};
 1865         print $map_fh qq{<AREA SHAPE="rect" COORDS="$x1,$y1,$x2,$y2" $target $title>\n};
 1866     }
 1867 
 1868     my $numdays = AbsenceDate::daysInMonth($month, $year);
 1869     #-----------------------------------------------------------------
 1870     # now write the areas for unreserved days
 1871     #-----------------------------------------------------------------
 1872     ($y1, $y2) = @{ $y_bounds };
 1873 
 1874     my $day = 1;
 1875 
 1876     while($day <= $numdays) {
 1877         $x1 = $ROW_LABEL_WIDTH + ($day - 1) * $COL_WIDTH + 1;
 1878         $x2 = $ROW_LABEL_WIDTH + $day * $COL_WIDTH - 1;
 1879         $target = "new,$pid,$gid,$day,$month,$year";
 1880         $target = qq[HREF="$CGI_DIR/absence-click.pl$inst?$target"];
 1881         print $map_fh qq[<AREA SHAPE="rect" COORDS="$x1,$y1,$x2,$y2" $target>\n];
 1882         $day++;
 1883     }
 1884 }
 1885 
 1886 sub removeMonthImages
 1887 {
 1888     my (@gid_list) = @_;
 1889 
 1890     $DEBUG && abslog("removeMonthImages() called with gids=[".join(',', @gid_list)."]");
 1891     local(*DIR);
 1892     opendir(DIR, $IMAGE_DIR_ABS) || die "opendir [$IMAGE_DIR_ABS]";
 1893     
 1894     my $it = AbsenceConfig::fetch('image_type');
 1895     my $file;
 1896 
 1897     my $re = '('.join('|',@gid_list).')';
 1898 
 1899     while($_ = readdir(DIR)) {
 1900         if ((@gid_list && /^absence-${re}-.*\.$it$/) ||
 1901             (!@gid_list && /^absence-.*\.$it$/))
 1902         {
 1903             $file = "$IMAGE_DIR_ABS/$_";
 1904             #$DEBUG && abslog("unlinking [$file]");
 1905             $DEBUG && abslog("unlinking [$file]");
 1906             unlink($file) || dbg("failed: $!");
 1907             my $map = $file;
 1908             $map =~ s/\.$it$/.map/;
 1909             -f $map && unlink($map) || dbg("failed to unlink map file: $!");
 1910         }
 1911     }
 1912     closedir(DIR);
 1913 }
 1914 
 1915 1;
 1916 
 1917 __END__
 1918 
 1919 =head1 NAME
 1920 
 1921 AbsenceImage.pm - handles manipulation of month-images and related functions
 1922 
 1923 =head1 SYNOPSIS
 1924 
 1925  AbsenceImage::create($month, $year, $group_id, $image_file, $mapname);
 1926  $arr_ref        = AbsenceImage::findAbsence($month, $year, $group_id, $x, $y);
 1927  $holiday_struct = AbsenceImage::findHoliday($month, $year, $x);
 1928  $legend_mtime   = AbsenceImage::makeLegend();
 1929  ($rel, $abs)    = AbsenceImage::legendFilePath();
 1930 
 1931 =head1 DESCRIPTION
 1932 
 1933 C<AbsenceImage.pm> presents an interface to month-image data.  It
 1934 handles the generation of month-images and, if map-type is server (which
 1935 is not well tested any more), also the querying of absence-data based on
 1936 an (X,Y) coordinate-pair (see C<findAbsence()>, C<findHoliday()>).
 1937 
 1938 =head1 FUNCTIONS
 1939 
 1940 =over 4
 1941 
 1942 =item B<create()>
 1943 
 1944 generates a month-image, which is written to output file specified.
 1945 
 1946 =item B<findAbsence()>
 1947 
 1948 map-type = server
 1949 
 1950 This is used when server-side image maps have been configured.
 1951 given a (X,Y) coordinate pair, determines what, if any, absence
 1952 entity corresponds to the pair, and returns a corresponding
 1953 data-structure as a list.  The possible return values are:
 1954 
 1955 =over 4
 1956 
 1957 =item (none => '')
 1958 
 1959 no entity exists matching the supplied coordinates
 1960 
 1961 =item (none => 'stop-that')
 1962 
 1963 coordinates correspond to padding at end of month with less than 31 days.
 1964 
 1965 =item (none => 'no-holiday')
 1966 
 1967 coordinates correspond to row holding day-numbers, but not to a holiday.
 1968 
 1969 =item (holiday => [$day, $month, $year, $holiday_description])
 1970 
 1971 coordinates correspond to row holding day-numbers and to a holiday.
 1972 
 1973 =item (absence => $absence_id)
 1974 
 1975 coordinates correspond to an existing absence.
 1976 
 1977 =item (start => [$person_id, $day, $month, $year])
 1978 
 1979 coordinates correspond to a valid unreserved person/day combination.
 1980 
 1981 =back
 1982 
 1983 =item B<findHoliday()>
 1984 
 1985 map-type = server
 1986 
 1987 findHoliday() isn't really public.  It's normally used by findAbsence().
 1988 Takes a $month, $year, and $x coordinate, and returns an array reference
 1989 if the $x coordinate corresponds to a holiday, or B<undef> if not.
 1990 
 1991 =back
 1992 
 1993 =head1 INTERNAL FUNCTIONS
 1994 
 1995 =over 4
 1996 
 1997 =item B<layoutObjectRow()>
 1998 
 1999 layoutObjectRow() is by far the nastiest function in this module. It must
 2000 be called with a list of reservations for an object (person) for a particular
 2001 month, and does more-or-less the following:
 2002 
 2003 1. goes through reservation list and sorts into 3 groups based on the height
 2004 of the reservation type (RT): "block", "non-block" top-to-bottom, and
 2005 "non-block" bottom-to-top
 2006 
 2007 2. the non-block height top-to-bottom reservations are then sorted according
 2008 to priority and then laid out on the object-row.
 2009 
 2010 3. the non-block bottom-to-top reservations are sorted and laid out on
 2011 the object-row.
 2012 
 2013 4. the block reservations are sorted according to priority and laid out
 2014 on the object-row.
 2015 
 2016 5. the layout is checked for forbidden combinations of reservation-types or
 2017 lack of space and an error-list is created.
 2018 
 2019 6. the result is returned, which consists of the number of the last slot
 2020 used for the layout, the list of reservations with beginning and ending
 2021 slot numbers, and the error-list.
 2022 
 2023 =back
 2024 
 2025 =head1 AUTHOR
 2026 
 2027 Robert Urban <urban@tru64.org>
 2028 
 2029 Copyright (C) 2003 Robert Urban
 2030 
 2031 =cut