"Fossies" - the Fresh Open Source Software Archive

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

    1 #!/usr/bin/perl
    2 
    3 #======================================================================
    4 #    This file is part of Absence.
    5 #
    6 #    Absence is free software: you can redistribute it and/or modify
    7 #    it under the terms of the GNU General Public License as published by
    8 #    the Free Software Foundation, either version 3 of the License, or
    9 #    (at your option) any later version.
   10 #
   11 #    Absence is distributed in the hope that it will be useful,
   12 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
   13 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   14 #    GNU General Public License for more details.
   15 #
   16 #    You should have received a copy of the GNU General Public License
   17 #    along with Absence.  If not, see <http://www.gnu.org/licenses/>.
   18 #======================================================================
   19 
   20 # $Id: absence.pl 116 2013-12-15 00:09:27Z urban $
   21 
   22 use CGI;
   23 # uncomment the following if you are debugging
   24 use CGI::Carp qw(fatalsToBrowser);
   25 
   26 $CGI::POST_MAX = 300;
   27 $CGI::DISABLE_UPLOADS = 1;
   28 
   29 #----------------------------------------------------------------
   30 # it is very important that this BEGIN block come before
   31 # "use AbsenceConfig;" below.  The INSTANCE_NAME environment
   32 # variable must be defined before AbsenceConfig is loaded.
   33 #----------------------------------------------------------------
   34 BEGIN {
   35     if ($ENV{QUERY_STRING} =~ /^instance=(\S+)$/) {
   36         # an instance has been specified
   37         $ENV{INSTANCE_NAME} = $1;
   38         $COOKIE_NAME = "absence-$1";
   39     }
   40     else {
   41         $COOKIE_NAME = 'absence';
   42     }
   43 }
   44 
   45 use AbsenceConfig;
   46 use AbsenceImage;
   47 use AbsenceLog;
   48 use AbsenceAuthentication;
   49 use AbsenceAuthorization;
   50 
   51 my $IMAGE_DIR_ABS   = AbsenceConfig::fetch('image_dir_abs');
   52 my $DATA_REL        = AbsenceConfig::fetch('data_dir_rel');
   53 my $CGI_DIR         = AbsenceConfig::fetch('cgi_dir_rel');
   54 my $MAP_TYPE        = AbsenceConfig::fetch('map_type');
   55 my $COOKIE_DOMAIN   = AbsenceConfig::fetch('cookie_domain');
   56 my $AUTH            = AbsenceConfig::fetch('authentication');
   57 my $AUTH_TYPE       = AbsenceConfig::fetch('auth_type');
   58 my $NPH_LO          = AbsenceConfig::fetch('nph_lo_script');
   59 #my $MAIN_SCRIPT        = AbsenceConfig::fetch('main_script');
   60 my $MARK_CM         = AbsenceConfig::fetch('mark_curr_month');
   61 my $MARK_CD         = AbsenceConfig::fetch('mark_curr_day');
   62 my $COLOR_MAIN      = AbsenceConfig::fetch('wp_main');
   63 my $AUTH_UID;
   64 
   65 my $DEBUG           = 0;
   66 my $DEF_MONTHS      = 6;
   67 my $VERSION         = '2.0.3';
   68 
   69 #--------------------------------------------------
   70 # GET-querys: default number of months to display
   71 #--------------------------------------------------
   72 my $DEFAULT_NUM_MONTHS  = 6;
   73 
   74 $SIG{__DIE__} = \&handleErrors;
   75 
   76 #=================================================================
   77 # main
   78 #=================================================================
   79 
   80 my ($month, $year) = (localtime)[4,5];
   81 $month++;
   82 $year += 1900;
   83 
   84 my $cgi = new CGI;
   85 $cgi->import_names;
   86 $cgi->charset('utf-8');
   87 
   88 my $group_id;
   89 
   90 #-----------------------------------------------------------------
   91 # first, authenticate if necessary
   92 #-----------------------------------------------------------------
   93 my $auth_cookie;
   94 ($AUTH_UID, $auth_cookie) = AbsenceAuthentication::authenticateUser($cgi);
   95 
   96 my @groups = AbsenceAuthorization::getReadGroups($AUTH_UID);
   97 
   98 #--------------------------------------------------------------
   99 # if this is a GET request, handle it and short-circuit the
  100 # rest of the processing
  101 #--------------------------------------------------------------
  102 if (defined($cgi->url_param('group_id'))) {
  103     print $cgi->header(-expires => '-1d'),
  104         $cgi->start_html(
  105             -title      => 'Absence',
  106             -BGCOLOR    => $COLOR_MAIN,
  107         );
  108     $group_id = $cgi->url_param('group_id');
  109     if (!AbsenceDB::groupExists(id => $group_id)) {
  110         print $cgi->h1("the group-ID [$group_id] does not exist.");
  111         print $cgi->end_html;
  112         exit;
  113     }
  114 
  115     my $start_month;
  116     my $start_year;
  117     # use current month and year if 'start_(month|year)' are not specified
  118     if (!defined($cgi->url_param('start_month')) ||
  119         !defined($cgi->url_param('start_year')))
  120     {
  121         $start_month = $month;
  122         $start_year = $year;
  123     } else {
  124         $start_month = $cgi->url_param('start_month');
  125         $start_year = $cgi->url_param('start_year');
  126     }
  127     my $num_months = $cgi->url_param('num_months') || $DEFAULT_NUM_MONTHS;
  128 
  129     display_group($cgi, 1, $group_id, $start_month, $start_year, $num_months);
  130 
  131     exit 0;
  132 }
  133 
  134 my @cookies;
  135 if ($auth_cookie) {
  136     push(@cookies, $auth_cookie);
  137 }
  138 
  139 #if ($AUTH && !defined($AUTH_UID)) {
  140 #   $AUTH_UID = AbsenceAuthentication::authenticateUser($cgi);
  141 #}
  142 
  143 if (defined($Q::action_logout)) {
  144     #if ($AUTH_TYPE eq 'http') {
  145     #   #reloadTop();
  146         abslog("uid [$AUTH_UID] logout");
  147     #}
  148     #else {
  149         logout($cgi);
  150     #}
  151 }
  152 
  153 #-----------------------------------------------------------------
  154 # other stuff
  155 #-----------------------------------------------------------------
  156 my %cookie = $cgi->cookie($COOKIE_NAME);
  157 
  158 my $chunk_mult  = 0;
  159 my $chunksize   = $DEF_MONTHS;
  160 
  161 my $cd = "cookie debugging...<BR>\n";
  162 
  163 if (exists($cookie{mult})) {
  164     $chunk_mult = $cookie{mult};
  165     $cd .= "cookie: MULT = $chunk_mult<BR>\n";
  166 }
  167 
  168 if (exists($cookie{chunksize})) {
  169     $chunksize = $cookie{chunksize};
  170     $cd .= "cookie: CHUNKSIZE = $chunksize<BR>\n";
  171 }
  172 
  173 if (exists($cookie{month})) {
  174     $month = $cookie{month};
  175     $year = $cookie{year};
  176     $cd .= "cookie: MONTH = $month, YEAR = $year<BR>\n";
  177 }
  178 
  179 if (exists($cookie{group_id})) {
  180     $group_id = $cookie{group_id};
  181     $DEBUG && abslog("GROUP-ID=[$group_id], defined=[".defined($group_id)."], len=".length($group_id));
  182     if (defined($group_id) && length($group_id)) {
  183         if (!AbsenceDB::groupExists(id => $group_id)) {
  184             $cd .= "group_id [$group_id] disappeared, erasing.\n";
  185             $group_id = undef;
  186         }
  187         $cd .= "cookie: GROUP_ID = $group_id<BR>\n";
  188     }
  189     else {
  190         $group_id = undef;
  191     }
  192 }
  193 
  194 $DEBUG && abslog("action = [$Q::action]");
  195 
  196 # if $Q::start_month is set, I know that a submit() took place
  197 
  198 if (($Q::start_month) || ($Q::jump =~ /^(Next|Previous)/)) {
  199     $year       = $cgi->param('start_year');
  200     $month      = $cgi->param('start_month');
  201     $chunksize  = $cgi->param('chunksize');
  202     $group_id   = $cgi->param('group_id');
  203 }
  204 
  205 if ($Q::jump =~ /^Next/) {
  206     if (!%cookie) {
  207         print $cgi->header(-expires => 'now'),
  208             $cgi->start_html('Absence'),
  209             $cgi->h1('The <EM>Next</EM> button will not work without cookies.');
  210         print $cgi->end_html;
  211         exit;
  212     }
  213     $chunk_mult++;
  214     $cd .= "must increment. now mult = $chunk_mult<BR>\n";
  215 }
  216 elsif ($Q::jump =~ /^Previous/) {
  217     if (!%cookie) {
  218         print $cgi->header(-expires => 'now'), $cgi->start_html('Absence');
  219         print $cgi->h1('The <EM>Previous</EM> button will not work without cookies.');
  220         print $cgi->end_html;
  221         exit;
  222     }
  223     $chunk_mult--;
  224     $cd .= "must decrement. now mult = $chunk_mult<BR>\n";
  225 }
  226 elsif ($Q::start_month) {
  227     $chunk_mult = 0;
  228     $cookie{month} = $month;
  229     $cookie{year} = $year;
  230     $cd .= "block = \$Q::start_month<BR>\n";
  231 }
  232 elsif ($Q::action eq '') {
  233     $cd .= "block = no action<BR>\n";
  234 }
  235 
  236 #-------------------------------------------------------------
  237 # always set cookie
  238 #-------------------------------------------------------------
  239 
  240 $cookie{chunksize} = $chunksize;
  241 $cookie{mult} = $chunk_mult;
  242 $cookie{group_id} = $group_id;
  243 $cookie = $cgi->cookie(
  244     -name   => $COOKIE_NAME,
  245     -value  => \%cookie,
  246     -path   => '/',
  247     #-domain    => $COOKIE_DOMAIN,
  248     -expires=> '+10y',
  249 );
  250 push(@cookies, $cookie);
  251 
  252 # for debugging
  253 #abslog("setting cookie:\n\tname=$COOKIE_NAME\n\tchunksize=$cookie{chunksize}\n\tmult=$cookie{mult}\n\tgid=$cookie{group_id}");
  254 
  255 if ($chunk_mult != 0) {
  256     ($month, $year) = moveByChunk($month, $year, $chunk_mult, $chunksize);
  257 }
  258 
  259 #my @cookies = (-cookie => $cookie);
  260 #if ($AUTHCOOK) { push(@cookies, (-cookie => $AUTHCOOK)); }
  261 
  262 #-------------------------------------------------------------
  263 # beginning of normal page construction
  264 #-------------------------------------------------------------
  265 print $cgi->header(-expires => '-1d', -cookie => \@cookies),
  266     $cgi->start_html(
  267         -title      => 'Absence',
  268         -BGCOLOR    => $COLOR_MAIN,
  269         -script     => 'function reload_control() { parent.control.location.reload(); }',
  270     );
  271 
  272 if ($AUTH) {
  273     my $path = AbsenceConfig::fetch('js_dir_rel') . '/logout.js';
  274     print qq{<script src="$path" type="text/javascript"></script>\n};
  275 }
  276 
  277 $DEBUG && print "$cd";
  278 
  279 if ($DEBUG) {
  280     print "\@groups = (".join(',', @groups).")<BR>\n";
  281 }
  282 
  283 if (!length($group_id) || !grep(/^${group_id}$/, @groups)) {
  284     if (@groups == 1) {
  285         $group_id = $groups[0];
  286     }
  287     else {
  288         print $cgi->h1('Select Group Above');
  289         print $cgi->end_html;
  290         exit;
  291     }
  292 }
  293 
  294 #print $cgi->h1('Absences for group FOOBAR');
  295 
  296 # debug
  297 if ($DEBUG) {
  298     print "DOCUMENT_ROOT = [$ENV{DOCUMENT_ROOT}]<BR>\n";
  299     my @keywords = $cgi->keywords;
  300     my @names = $cgi->param;
  301 
  302     print "URL Parameters:<BR>\n";
  303     my @url_params = $cgi->url_param;
  304     foreach my $p (@url_params) {
  305         print " [$p] ".$cgi->url_param($p)."<BR>\n";
  306     }
  307 
  308     print "Parameters:<BR>\n";
  309     foreach my $p (@names) {
  310         print " [$p] ".$cgi->param($p)."<BR>\n";
  311     }
  312 
  313     print "<P>Keywords:<BR>\n";
  314     foreach my $p (@keywords) {
  315         print " [$p]<BR>\n";
  316     }
  317 
  318     if ($cookie{chunksize}) {
  319         print "CHUNKSIZE: [$chunksize]<BR>\n";
  320     }
  321     print "chunk_mult = [$chunk_mult]<BR>\n";
  322     #print "<P>ENVIRONMENT:<BR><TABLE>\n";
  323     #foreach my $var (sort keys(%ENV)) {
  324     #   print "<TR><TH ALIGN=right>$var</TH><TD>$ENV{$var}</TD></TR>\n";
  325     #}
  326     #print "</TABLE>\n";
  327 }
  328 
  329 display_group($cgi, 0, $group_id, $month, $year, $chunksize);
  330 
  331 exit 0;
  332 
  333 #=====================================================================
  334 # subs
  335 #=====================================================================
  336 
  337 sub display_group
  338 {
  339     my ($cgi, $read_only, $group_id, $month, $year, $num_months) = @_;
  340 
  341     my $legend_rel = (AbsenceImage::legendFilePath())[0];
  342     my $legend_mtime = AbsenceImage::makeLegend();
  343 
  344     print qq[<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0><TR><TD>\n];
  345     print qq[<IMG BORDER=2 SRC="$legend_rel?$legend_mtime"></A>\n];
  346     print qq[</TD><TD>\n];
  347     $read_only || print qq[&nbsp;(<A HREF="$DATA_REL/absence-help.html">instructions</A>)&nbsp;];
  348 
  349     if (
  350         !$AUTH
  351         && AbsenceConfig::fetch('partial_auth_hack')
  352         && !AbsenceAuthentication::isAuthed()
  353     )
  354     {
  355         print qq[<BR>&nbsp;(<A HREF="$CGI_DIR/absence.pl?action=partial_auth">admin</A>)&nbsp;];
  356 
  357     }
  358     print "</TD>\n";
  359 
  360     if ($AUTH) {
  361         print "<TD VALIGN=bottom><BR>\n";
  362         my $username = AbsenceDB::getUser(id => $AUTH_UID, 'username');
  363         if ($AUTH_TYPE eq 'simple') {
  364             print $cgi->start_form(-method => 'POST'),
  365                 $cgi->submit(action_logout => "Logout $username"),
  366                 $cgi->end_form();
  367         }
  368         elsif ($AUTH_TYPE eq 'http') {
  369             # doesn't work just now
  370             #print $cgi->start_form(-action => $NPH_LO, -method => 'GET'),
  371             #   $cgi->submit(action => 'Logout'),
  372             #   $cgi->end_form();
  373             # use JS instead
  374             print $cgi->start_form(-method => 'GET'),
  375                 $cgi->submit(action_logout => "Logout $username"),
  376                 $cgi->end_form();
  377         }
  378         print "</TD>\n";
  379     }
  380 
  381     print "</TR></TABLE><BR>\n";
  382 
  383     if ($DEBUG) {
  384         print "remote_user = [$ENV{REMOTE_USER}]<BR>\n";
  385         print "auth_uid = [$AUTH_UID]<BR>\n";
  386         print qq[<A HREF="/cgi-bin/del-auth-cookie.pl">delete auth cookie</A><BR>\n];
  387     }
  388 
  389     #---------------------
  390     # more debug stuff...
  391     #---------------------
  392     #print "environment:<BR>\n<TABLE>\n";
  393     #foreach my $key (sort keys(%ENV)) {
  394     #   printf("<TR><TD>%s</TD><TD>%s</TD></TR>\n", $key, $ENV{$key});
  395     #}
  396     #print "</TABLE>\n";
  397 
  398     my $count = 0;
  399     my $inst;
  400     my %mmodtimes;
  401     my ($modtime, $targ);
  402 
  403     if (exists($ENV{INSTANCE_NAME})) { $inst = "/in=$ENV{INSTANCE_NAME}"; }
  404 
  405     my $it = AbsenceConfig::fetch('image_type');
  406 
  407     while($count < $num_months) {
  408         my $image_fn = "absence-$group_id-$month-$year.$it";
  409         my $map_fn = "absence-$group_id-$month-$year.map";
  410         my $image_out = "$IMAGE_DIR_ABS/$image_fn";
  411         my $map_out = "$IMAGE_DIR_ABS/$map_fn";
  412         my $mapname = "g${group_id}m${month}y$year";
  413         my $in = "${DATA_REL}/img/$image_fn";
  414         my $older = imageStale($image_out, $group_id, $month, $year);
  415         if ($MARK_CM || $MARK_CD) {
  416             #abslog("loop: $month/$year");
  417             if (currentChanged($group_id, $month, $year)) {
  418                 #abslog("loop2: currentChanged returned 1");
  419                 $older = 1;
  420             }
  421         }
  422         if ((! -e $image_out) || $older) {
  423             if ($DEBUG) {
  424                 if (! -e $image_out) { abslog("[$image_out] not found"); }
  425                 if ($older) { abslog("older"); }
  426             }
  427             #print "-creating $image_out -<BR>\n";
  428             #print "<!-- creating [$image_out] -->\n";
  429             $DEBUG && abslog("creating [$image_out]");
  430             $mmodtimes{$year}->{$month} = time();
  431             AbsenceImage::create($month, $year, $group_id, $image_out, $map_out, $mapname);
  432         }
  433 
  434         $modtime = (stat($image_out))[9];
  435         my ($width, $height) = AbsenceDB::getImageDimensions($group_id, $month, $year);
  436         if ($MAP_TYPE eq 'server') {
  437             $targ = "${CGI_DIR}/absence-click.pl$inst/${group_id}-${month}-$year";
  438             my @ismap_params = $read_only ? () : (-ismap    => undef);
  439             print $cgi->a(
  440                 { -href => $targ },
  441                 $cgi->img(
  442                     {
  443                         -src    => "$in?$modtime",
  444                         -border => 2,
  445                         -width  => $width,
  446                         -height => $height,
  447                         @ismap_params,
  448                     }
  449                 ),
  450             );
  451         }
  452         else {
  453             $read_only || printMap($map_out);
  454             my @map_params = $read_only ? () : (-usemap => "#$mapname");
  455             print $cgi->img(
  456                     {
  457                         -src    => "$in?$modtime",
  458                         -border => 2,
  459                         -width  => $width,
  460                         -height => $height,
  461                         @map_params,
  462                     }
  463                 );
  464         }
  465         print "<BR>\n";
  466 
  467         if ($month == 12) {
  468             $year++;
  469             $month = 1;
  470         }
  471         else {
  472             $month++;
  473         }
  474 
  475         $count++;
  476     }
  477 
  478     if (%mmodtimes) {
  479         AbsenceDB::updateMonthModTimes($group_id, \%mmodtimes);
  480     }
  481 
  482     print $cgi->end_html;
  483 }
  484 
  485 sub printMap
  486 {
  487     my $filename = shift;
  488 
  489     open(MAP, $filename) || die "could not open map [$filename]: $!";
  490     while(<MAP>) {
  491         print;
  492     }
  493     close(MAP);
  494 }
  495 
  496 sub handleErrors
  497 {
  498     my $msg = shift;
  499     confess($msg);
  500 }
  501 
  502 #---------------------------------------------------------------------
  503 # currentChanged()
  504 # ----------------
  505 # determine if the current month or current day has changed since
  506 # the current month/day was last determined
  507 #---------------------------------------------------------------------
  508 sub currentChanged
  509 {
  510     my ($gid, $month, $year) = @_;
  511     my $jm = $year * 12 + $month;
  512 
  513     #----------------------------------------------------
  514     # get last modification time from database
  515     #----------------------------------------------------
  516     my $mod_time = AbsenceDB::getModificationTime($gid, $month, $year);
  517     defined($mod_time) || return 1;
  518 
  519     my ($md, $mm, $my) = (localtime($mod_time))[3,4,5];
  520     $mm++;
  521     $my += 1900;
  522     my $mt_jm = $my * 12 + $mm;
  523 
  524     #----------------------------------------------------
  525     # get current values
  526     #----------------------------------------------------
  527     my ($d, $m, $y) = (localtime)[3,4,5];
  528     $m++;
  529     $y += 1900;
  530     my $curr_jm = $my * 12 + $mm;
  531 
  532     #----------------------------------------------------
  533     # is the image in question for the current month?
  534     #----------------------------------------------------
  535     if ($jm == $curr_jm) {
  536         if ($mt_jm != $jm) { return 1; }
  537         if ($MARK_CD) {
  538             if ($d == $md) {
  539                 return 0;
  540             }
  541             else {
  542                 return 1;
  543             }
  544         }
  545         else {
  546             # don't care about current day, so image is still ok
  547             return 0;
  548         }
  549     }
  550     else {
  551         if ($mt_jm == $jm) {
  552             # image was last generated when it was the current month
  553             return 1;
  554         }
  555         return 0;
  556     }
  557 }
  558 
  559 sub imageStale
  560 {
  561     my ($file, $gid, $month, $year) = @_;
  562 
  563     my $fmt = (stat($file))[9];
  564     my $smt = AbsenceDB::getModificationTime($gid, $month, $year);
  565 
  566     if (!defined($smt)) {
  567         $DEBUG && abslog("no modtime found for [$gid-$month/$year]");
  568         return 1;
  569     }
  570 
  571     #print "<!-- fmt=[$fmt], smt=[$smt] -->\n";
  572     if ($fmt < $smt) {
  573         $DEBUG && abslog("$gid-$month/$year: older\nfmt=[$fmt], smt=[$smt]");
  574         return 1;
  575     }
  576     $DEBUG && abslog("$gid-$month/$year: current");
  577     return 0;
  578 }
  579 
  580 sub moveByChunk
  581 {
  582     my ($month, $year, $mult, $chunksize) = @_;
  583 
  584     my $tmp = $year * 12 + $month;
  585     $tmp += ($mult * ($chunksize - 1));
  586     if ($chunksize != 1) { $tmp--; }
  587 
  588     my $m = $tmp % 12 + 1;
  589     my $y = int($tmp/12);
  590 
  591     ($m, $y);
  592 }
  593 
  594 sub logout
  595 {
  596     my $cgi = shift;
  597     AbsenceAuthentication::logout($cgi);
  598     exit 0;
  599 }
  600 
  601 __END__
  602 
  603 =head1 NAME
  604 
  605 absence.pl - heart of web-absence
  606 
  607 =head1 DESCRIPTION
  608 
  609 C<absence.pl> is responsible for displaying the month-images
  610 in the main frame (below the control frame).  C<absence.pl> gets
  611 the information about groups and months to display first from
  612 C<absence-control.pl> vi CGI, and secondly via cookies (i.e.,
  613 C<absence-control.pl> has precedence).
  614 
  615 =cut