"Fossies" - the Fresh Open Source Software Archive

Member "absence-v2.1/cgi-bin/absence-manage.pl.dna" (10 Dec 2013, 65774 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.

    1 #!/usr/bin/perl
    2 
    3 # $Id: absence-manage.pl 91 2009-07-14 15:58:06Z urban $
    4 
    5 #=====================================================================
    6 # Welcome to "absence-manage.pl"!
    7 #
    8 # absence-manage.pl is somewhat complicated because it is called at
    9 # two stages (see also the comments at the top of absence-click.pl).
   10 #
   11 # Stage 1:
   12 #
   13 # user clicks on the "manage" URL in the control frame and is presented
   14 # with a number of forms for managing people and groups.
   15 #
   16 # Stage 2:
   17 #
   18 # user clicks on one of the submit buttons belonging to one of the
   19 # forms above and the script is re-entered with some CGI parameters
   20 # set.
   21 #=====================================================================
   22 
   23 use CGI qw/:standard -debug/;
   24 # uncomment the following if you are debugging
   25 use CGI::Carp qw(fatalsToBrowser);
   26 use FileHandle;
   27 use Carp;
   28 
   29 BEGIN {
   30     if ($ENV{QUERY_STRING} =~ /^instance=(\S+)$/) {
   31         # an instance has been specified
   32         $ENV{INSTANCE_NAME} = $1;
   33     }
   34 }
   35 
   36 use AbsenceDB;
   37 use AbsenceConfig;
   38 use AbsenceLog;
   39 use AbsenceAuthentication;
   40 use AbsenceAuthorization;
   41 use AbsenceImage;
   42 use AbsenceInput;
   43 use Data::Dumper;
   44 
   45 #--------------------------------------------------------------------
   46 # global variables
   47 #--------------------------------------------------------------------
   48 my $IMAGE_DIR       = AbsenceConfig::fetch('image_dir_abs');
   49 my $TOP_PAGE        = AbsenceConfig::fetch('top_page');
   50 my $MAIN_SCRIPT     = AbsenceConfig::fetch('main_script');
   51 my $GROUP_POLICY    = AbsenceConfig::fetch('group_policy');
   52 my $OAP             = AbsenceConfig::fetch('objects_are_people');
   53 my $AUTH            = AbsenceConfig::fetch('authentication');
   54 #my $CRED_SRC       = AbsenceConfig::fetch('credential_src');
   55 my $MANAGE_PASSWORD = AbsenceConfig::fetch('manage_password');
   56 my $COLOR_NOPRIV    = AbsenceConfig::fetch('wp_nopriv');
   57 my $COLOR_MANAGE    = AbsenceConfig::fetch('wp_manage');
   58 my $MULTI_RES       = AbsenceConfig::fetch('multi_res');
   59 my $THING           = $OAP ? 'person' : 'object';
   60 my $UCF_THING       = ucfirst($THING);
   61 my $JS_COLOR_PATH   = jsColorScriptPath();
   62 
   63 my $JS_COLOR        = {
   64     -src    => $JS_COLOR_PATH,
   65     -type   => "text/javascript",
   66 };
   67 
   68 #my $DEBUG_OUT  = '/tmp/manage.log';
   69 my $VERSION     = '1.6';
   70 my $DEBUG       = 1;
   71 
   72 $CGI::POST_MAX = 2000;
   73 $CGI::DISABLE_UPLOADS = 1;
   74 
   75 #--------------------------------------------------------------------
   76 # main()
   77 #--------------------------------------------------------------------
   78 $SIG{__DIE__} = \&handleErrors;
   79 
   80 if (exists($ENV{INSTANCE_NAME})) {
   81     $MAIN_SCRIPT .= "?instance=$ENV{INSTANCE_NAME}";
   82 }
   83 
   84 my $q = new CGI;
   85 $q->import_names;
   86 $q->charset('utf-8');
   87 
   88 #-----------------------------------------------------------------
   89 # first, authenticate if necessary
   90 #-----------------------------------------------------------------
   91 my $AUTH_UID        = AbsenceAuthentication::checkAuthentication($q);
   92 my $SUPER_USER      = AbsenceAuthorization::checkSuperuser($AUTH_UID);
   93 my @ADMIN_GROUPS    = AbsenceAuthorization::getAdminGroups($AUTH_UID);
   94 
   95 #-----------------------------------------------------------------
   96 # check if $AUTH_UID is allowed to perform any admin tasks. If not,
   97 # complain.
   98 #-----------------------------------------------------------------
   99 if ($AUTH
  100     && (!$SUPER_USER && !@ADMIN_GROUPS)
  101     && (defined($Q::action)
  102         || defined($Q::action_add_object)
  103         || defined($Q::action_delete_object)
  104         || defined($Q::action_modify_object))
  105     && ($Q::action ne 'Change Password'))
  106 {
  107     print $q->header();
  108     print $q->start_html(
  109         -title      => 'Absence: Manage People',
  110         -target     => 'display',
  111         -BGCOLOR    => $COLOR_NOPRIV,
  112     ),
  113     "<H3>You do not have any admin priviledges.</H3>\n",
  114     $q->end_html();
  115     exit;
  116 }
  117 
  118 
  119 # DEBUG
  120 if ($DEBUG) {
  121     my @keywords = $q->keywords;
  122     my @names = $q->param;
  123     dbg('Parameters:');
  124     foreach my $p (@names) {
  125         dbg(" [$p] ".$q->param($p));
  126     }
  127 
  128     dbg("Keywords:");
  129     foreach my $p (@keywords) {
  130         dbg(" [$p] ");
  131     }
  132 }
  133 
  134 
  135 if (defined($Q::action_add_object)) {
  136     addPerson($q);
  137 } elsif (defined($Q::action_delete_object)) {
  138     deletePerson($q);
  139 } elsif (defined($Q::action_modify_object)) {
  140     modifyPersonForm($q);
  141 } elsif ($Q::action eq 'Add User') {
  142     addUser($q);
  143 } elsif ($Q::action eq 'Modify User') {
  144     modifyUserForm($q);
  145 } elsif ($Q::action eq 'Delete User') {
  146     deleteUser($q);
  147 } elsif ($Q::action eq 'Modify Group') {
  148     modifyGroupForm($q);
  149 } elsif ($Q::action eq 'Delete Group') {
  150     deleteGroup($q);
  151 } elsif ($Q::action eq 'Add Group') {
  152     addGroup($q);
  153 } elsif ($Q::action eq 'Submit Modification') {
  154     dbg("got [Submit Modification]");
  155     modifyPerson($q);
  156 } elsif ($Q::action eq 'Submit Group Modification') {
  157     modifyGroup($q);
  158 } elsif ($Q::action eq 'Submit User Modification') {
  159     modifyUser($q);
  160 } elsif ($Q::action eq 'Change Password') {
  161     changePassword($q);
  162 } elsif ($Q::action eq 'Add Type') {
  163     addType($q);
  164 } elsif ($Q::action eq 'Modify Type') {
  165     modifyTypeForm($q);
  166 } elsif ($Q::action eq 'Deactivate Type') {
  167     deactivateType($q);
  168 } elsif ($Q::action eq 'Reactivate Type') {
  169     reactivateType($q);
  170 } elsif ($Q::action eq 'Submit Type Modification') {
  171     modifyType($q);
  172 }
  173 
  174 print $q->header(-expires => '-1d');
  175 print $q->start_html(
  176     -title      => 'Absence: Manage People',
  177     -target     => 'display',
  178     -BGCOLOR    => $COLOR_MANAGE,
  179     -script     => $JS_COLOR,
  180 );
  181 
  182 # include JavaScript for ACL-managment if necessary
  183 if ($AUTH) {
  184     includeJsAclScript();
  185 }
  186 
  187 #print "<H2>AUTH = [$AUTH]</H2>\n";
  188 
  189 ($AUTH && $MANAGE_PASSWORD) && changePasswordForm();
  190 if ($AUTH && !$SUPER_USER && !@ADMIN_GROUPS) {
  191     $MANAGE_PASSWORD || print "-- Nothing to Manage --\n";
  192     $q->end_html();
  193     exit;
  194 }
  195 
  196 print "<HR><P>\n";
  197 print $q->h1({-align => 'center'},'Manage People, Groups &amp; Users');
  198 
  199 print "<HR>\n<P>\n";
  200 
  201 mainAddPersonForm($q);
  202 mainModifyPersonForm($q);
  203 mainDeletePersonForm($q);
  204 
  205 my $hack = AbsenceConfig::fetch('partial_auth_hack');
  206 my $show = ($AUTH && $SUPER_USER)
  207     || (!$AUTH && (!$hack || ($hack && AbsenceAuthentication::isAuthed())));
  208 
  209 if (!$AUTH || $SUPER_USER) {
  210     mainAddGroupForm($q);
  211     mainModifyGroupForm($q);
  212     mainDeleteGroupForm($q);
  213     if ($show) {
  214         mainAddTypeForm($q);
  215         mainModifyTypeForm($q);
  216         mainDeactivateTypeForm($q);
  217         mainReactivateTypeForm($q);
  218     }
  219 }
  220 
  221 if ($AUTH) {
  222     mainAddUserForm($q);
  223     mainModifyUserForm($q);
  224     mainDeleteUserForm($q);
  225 }
  226 
  227 
  228 print $q->start_form(-action => $MAIN_SCRIPT, -method => 'POST');
  229 print $q->submit(action => 'Cancel');
  230 print $q->end_form();
  231 print $q->end_html();
  232 
  233 exit;
  234 
  235 sub handleErrors
  236 {
  237     my $msg = shift;
  238 
  239     confess($msg);
  240 }
  241 
  242 #=================================================================
  243 #=================================================================
  244 # first level forms
  245 #=================================================================
  246 #=================================================================
  247 
  248 sub changePasswordForm
  249 {
  250     my $username = AbsenceDB::getUser(id => $AUTH_UID, 'username');
  251     print $q->h1("Change Password for $username");
  252     print $q->start_form(
  253         -name       => 'change_password',
  254     );
  255     print "<TABLE>\n";
  256     print "<TR><TH ALIGN=right>New Password</TH><TD>\n";
  257     print $q->password_field(
  258         -name       => 'password1',
  259         -size       => 30,
  260         -maxlength  => 30,
  261     );
  262     print "</TD></TR>\n";
  263     print "<TR><TH ALIGN=right>New Password (again)</TH><TD>\n";
  264     print $q->password_field(
  265         -name       => 'password2',
  266         -size       => 30,
  267         -maxlength  => 30,
  268     );
  269     print "</TD></TR>\n</TABLE>\n";
  270     print $q->submit(action => 'Change Password');
  271     print $q->end_form();
  272 }
  273 
  274 sub changePassword
  275 {
  276     my $q = shift;
  277 
  278     if (!length($Q::password1) || !length($Q::password2)) {
  279         dbg("looks bad");
  280         reloadDisplay($q, 'Error changing password',
  281             'one or both password fields blank');
  282     }
  283 
  284     if ($Q::password1 ne $Q::password2) {
  285         dbg("looks bad");
  286         reloadDisplay($q, 'Error changing password', 'password mismatch');
  287     }
  288 
  289     my $ret = AbsenceDB::setPassword($AUTH_UID, $Q::password1);
  290     dbg("ret = [$ret]");
  291 
  292     if ($ret eq 'ok') {
  293         dbg("looks good");
  294         print $q->redirect($MAIN_SCRIPT);
  295     } elsif ($ret eq 'disappeared') {
  296         dbg("looks bad");
  297         reloadDisplay($q, 'Error changing password',
  298             "user [$AUTH_UID] disappeared");
  299     } elsif ($ret =~ /^baddata:\s(.*)$/) {
  300         dbg("looks bad");
  301         reloadDisplay($q, 'Error changing password',
  302             $1);
  303     } elsif ($ret eq 'error') {
  304         dbg("looks bad");
  305         reloadDisplay($q, 'Error changing password', 'error changing password');
  306     }
  307 
  308     exit;
  309 }
  310 
  311 #---------------------------------------------------------------
  312 # ADD PERSON
  313 #---------------------------------------------------------------
  314 
  315 sub mainAddPersonForm
  316 {
  317     my $q = shift;
  318 
  319     print $q->h1("Add a $UCF_THING");
  320     print qq[<P>A "$UCF_THING" is an visible object which can have absences
  321         assigned to it.<P>];
  322     my @onsubmit = ($OAP && $AUTH)
  323         ? (-onSubmit   => 'return validate(document.add_person);') 
  324         : ();
  325     print $q->start_form(
  326         -name       => 'add_person',
  327         @onsubmit,
  328     );
  329     print "<TABLE>\n";
  330 
  331     #------------------------
  332     # Name
  333     #------------------------
  334     print "<TR><TH ALIGN=right>Name (Last, First)</TH><TD>\n";
  335     print $q->textfield(
  336         -name       => 'name',
  337         -size       => 20,
  338         -maxlength  => 20,
  339     );
  340     print "</TD><TD>[This will appear in the month-images]</TD></TR>\n";
  341 
  342     if ($AUTH && $OAP) {
  343         #------------------------
  344         # User-ID
  345         #------------------------
  346         print "<TR><TH ALIGN=right>Username</TH><TD>\n";
  347         print $q->textfield(
  348             -name       => 'username',
  349             -size       => 20,
  350             -maxlength  => 20,
  351         );
  352         print "</TD><TD>[This is the login-name]</TD></TR>\n";
  353         #------------------------
  354         # password
  355         #------------------------
  356         if ($MANAGE_PASSWORD) {
  357             print "<TR><TH ALIGN=right>Password</TH><TD>\n";
  358             print $q->textfield(
  359                 -name       => 'password',
  360                 -size       => 30,
  361                 -maxlength  => 30,
  362             );
  363             print "</TD></TR>\n";
  364         }
  365     }
  366 
  367     #------------------------
  368     # E-mail
  369     #------------------------
  370     print "<TR><TH ALIGN=right>E-Mail Address</TH><TD>\n";
  371     print $q->textfield(
  372         -name       => 'email',
  373         -size       => 30,
  374         -maxlength  => 50,
  375     );
  376 
  377     #------------------------
  378     # groups
  379     #------------------------
  380     print "<TR><TH ALIGN=right VALIGN=top>Group</TH><TD>\n";
  381     ($GROUP_POLICY eq 'single')
  382         ? makeGroupPopup($q)
  383         : makeGroupCheckboxes($q, []);
  384 
  385     print "</TD>
  386         <TD VALIGN=top>
  387             [choose which groups this person should belong to]
  388         </TD></TR>\n";
  389 
  390     ($AUTH && $OAP) && aclForm($q, 'add_person');
  391 
  392     print "</TABLE>\n";
  393     print $q->submit(action_add_object => 'Add Person');
  394     print $q->end_form();
  395     print "<HR>\n";
  396 }
  397 
  398 #---------------------------------------------------------------
  399 # MODIFY PERSON
  400 #---------------------------------------------------------------
  401 
  402 sub mainModifyPersonForm
  403 {
  404     my $q = shift;
  405 
  406     print $q->h1("Modify a $UCF_THING");
  407     print $q->start_form;
  408     print "$UCF_THING";
  409     makePeoplePopup($q);
  410     print "&nbsp;";
  411     print $q->submit(action_modify_object => "Modify $UCF_THING");
  412     print $q->end_form();
  413     print "<HR>\n";
  414 }
  415 
  416 #---------------------------------------------------------------
  417 # DELETE PERSON
  418 #---------------------------------------------------------------
  419 
  420 sub mainDeletePersonForm
  421 {
  422     my $q = shift;
  423 
  424     print $q->h1("Delete a $UCF_THING");
  425     print $q->start_form;
  426     print "$UCF_THING";
  427     makePeoplePopup($q, 'delete');
  428 
  429     print "&nbsp;";
  430     print $q->submit(action_delete_object => "Delete $UCF_THING");
  431     #print $q->submit(
  432     #   -name   => 'action',
  433     #   -label  => "Delete huhu",
  434     #   -action => "Delete $UCF_THING",
  435     #);
  436     print $q->end_form();
  437 
  438     print "<HR>\n";
  439 }
  440 
  441 #---------------------------------------------------------------
  442 # ADD GROUP
  443 #---------------------------------------------------------------
  444 
  445 sub mainAddGroupForm
  446 {
  447     my $q = shift;
  448 
  449     print $q->h1('Add a Group');
  450     print qq[<P>A "group" is a collection of "${THING}s".<P>];
  451     print $q->start_form;
  452     print "Name\n";
  453     print $q->textfield(
  454             -name       => 'name',
  455             -size       => 20,
  456             -maxlength  => 20,
  457         ), '<BR>',
  458         'Description',
  459         $q->textfield(
  460             -name       => 'description',
  461             -size       => 40,
  462             -maxlength  => 80,
  463         );
  464     print "&nbsp;";
  465 
  466     print $q->submit(action => 'Add Group');
  467     print $q->end_form();
  468 }
  469 
  470 #---------------------------------------------------------------
  471 # MODIFY GROUP
  472 #---------------------------------------------------------------
  473 
  474 sub mainModifyGroupForm
  475 {
  476     my $q = shift;
  477 
  478     print "<HR>\n";
  479 
  480     print $q->h1('Modify a group');
  481     print $q->start_form(-name => 'ModifyGroup');
  482     print "Group";
  483     makeGroupPopup($q);
  484     print "&nbsp;";
  485     print $q->submit(action => 'Modify Group');
  486     print $q->end_form();
  487 
  488     print "<HR>\n";
  489 }
  490 
  491 #---------------------------------------------------------------
  492 # DELETE GROUP
  493 #---------------------------------------------------------------
  494 
  495 sub mainDeleteGroupForm
  496 {
  497     my $q = shift;
  498 
  499     print $q->h1('Delete a group');
  500     if ($GROUP_POLICY eq 'single') {
  501         print "(this will also delete <EM>all</EM> members of the group)<BR>\n";
  502     } else {
  503         print "(this will also delete <EM>all</EM> members of the group\n";
  504         print "who are in no other groups)<BR>\n";
  505     }
  506     print $q->start_form(-name => 'DeleteGroup');
  507     print "Group";
  508     makeGroupPopup($q);
  509     print "&nbsp;";
  510     print $q->submit(action => 'Delete Group');
  511     print $q->end_form();
  512 
  513     print "<HR>\n";
  514 }
  515 
  516 #---------------------------------------------------------------
  517 # MANAGE TYPES
  518 #---------------------------------------------------------------
  519 
  520 # <input class="color" id="bg" onchange="updateBg()" value="0066FF" size="10" />
  521 
  522 sub jsColorScriptPath
  523 {
  524     my $base = AbsenceConfig::fetch('js_dir_rel');
  525     my $path = "$base/jscolor.js";
  526 }
  527 
  528 sub includeJsColorScript
  529 {
  530     my $path = jsColorScriptPath();
  531     print qq{<script src="$path" type="text/javascript"></script>\n};
  532 }
  533 
  534 sub mainAddTypeForm
  535 {
  536     my $q = shift;
  537 
  538     includeJsRtCoincidenceScript();
  539     print $q->h1('Add a Reservation Type');
  540     print $q->start_form(-name => 'add_type');
  541     if ($MULTI_RES) { print "<TABLE><TR><TD VALIGN=TOP>\n"; }
  542     print "<TABLE>\n";
  543     print "<TR><TH ALIGN=right>Type Name</TH><TD>\n",
  544         $q->textfield(
  545             -name       => 'name',
  546             -size       => 20,
  547             -maxlength  => 20,
  548         ),
  549         "</TD></TR><TR><TH ALIGN=right>Description</TH><TD>\n",
  550         $q->textfield(
  551             -name       => 'description',
  552             -size       => 40,
  553             -maxlength  => 80,
  554         ),
  555         "</TD></TR><TR><TH ALIGN=right>Color</TH><TD>\n",
  556         $q->textfield(
  557             -name       => 'color',
  558             -size       => 8,
  559             -maxlength  => 8,
  560             -class      => 'color',
  561         );
  562     if ($MULTI_RES) {
  563         print "</TD></TR><TR><TH ALIGN=right>Transparency</TH><TD>\n",
  564             $q->popup_menu(
  565                 -name       => 'transparency',
  566                 -values     => [0..100],
  567                 -default    => 0,
  568             );
  569     }
  570     print "</TD></TR><TR><TH ALIGN=right>Default</TH><TD>\n",
  571         $q->checkbox(
  572             -name       => 'default_type',
  573             -checked    => 0,
  574             -value      => 'on',
  575             -label      => '',
  576         ),
  577         "</TD></TR><TR><TH ALIGN=right>Skip Non Workdays</TH><TD>\n",
  578         $q->checkbox(
  579             -name       => 'skip_non_workdays',
  580             -checked    => 0,
  581             -value      => 'on',
  582             -label      => '',
  583         );
  584         if ($MULTI_RES) {
  585             print "</TD></TR><TR><TH ALIGN=right>Height</TH><TD>\n",
  586                 makeTypeHeightPopup($q, 'document.add_type'),
  587                 "</TD></TR><TR><TH ALIGN=right>Priority</TH><TD>\n",
  588                 $q->popup_menu(
  589                     -name       => 'priority',
  590                     -values     => [reverse(-10..-1,1..10)],
  591                     -default    => 10,
  592                 ),
  593                 "</TD></TR></TABLE>\n",
  594                 "</TD><TD>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</TD><TD>\n";
  595             makeCoincidenceCheckboxes($q, undef, undef, 'block');
  596         }
  597     print "</TD></TR><TABLE>\n";
  598     print "&nbsp;";
  599 
  600     print $q->submit(action => 'Add Type');
  601     print $q->end_form();
  602 }
  603 
  604 sub makeTypeHeightPopup
  605 {
  606     my ($q, $form, $default) = @_;
  607 
  608     $DEBUG && abslog("makeTypeHeightPopup: form=[$form]");
  609 
  610     if (!defined($default)) {
  611         $default = 'full';
  612     }
  613 
  614     my @values = ('quarter', 'half', 'full', 'block');
  615 
  616     return $q->popup_menu(
  617         -name       => 'height',
  618         -values     => \@values,
  619         -default    => $default,
  620         -onChange   => "change_height($form);",
  621     );
  622 }
  623 
  624 sub makeCoincidenceCheckboxes
  625 {
  626     my ($q, $type_id, $defaults, $disable) = @_;
  627 
  628     my @types = AbsenceDB::getTypes();
  629 
  630     my ($block_labels, $non_block_labels, @block_values, @non_block_values);
  631     my (@default_block, @default_non_block);
  632     my $myself;
  633     foreach my $type (sort { $a->{name} cmp $b->{name} } @types) {
  634         if (defined($type_id) && ($type->{id} eq $type_id)) {
  635             $myself = $type;
  636             next;
  637         }
  638         my $height = defined($type->{height}) ? $type->{height} : 'full';
  639         my $def_ref;
  640         if ($height eq 'block') {
  641             push(@block_values, $type->{id});
  642             $block_labels->{ $type->{id} } = $type->{name};
  643             $def_ref = \@default_block;
  644         } else {
  645             push(@non_block_values, $type->{id});
  646             $non_block_labels->{ $type->{id} } = ($height eq 'full')
  647                 ? $type->{name}
  648                 : "$type->{name} ($height)";
  649             $def_ref = \@default_non_block;
  650         }
  651         if (inListN($type->{id}, $defaults)) {
  652             push(@{ $def_ref }, $type->{id});
  653         }
  654     }
  655     if ($DEBUG) {
  656         abslog("default_block=[".join(',', @default_block)."]");
  657         abslog("default_non_block=[".join(',', @default_non_block)."]");
  658     }
  659 
  660     print "<B>Reservation-Type can NOT be used on same day<BR>with the following types:</B><BR>\n";
  661     my $checked = 0;
  662     if (defined($type_id)) {
  663         $checked = AbsenceDB::checkVorbidTypeCoincidence($type_id, $type_id);
  664     }
  665     print "<TABLE RULES=all CELLSPACING=4 CELLPADDING=4 BORDER=1><TR><TD COLSPAN=2>\n";
  666     print $q->checkbox(
  667             -name       => 'self_coincidence',
  668             -checked    => $checked,
  669             -value      => 'on',
  670             -label      => defined($type_id)
  671                 ? "$myself->{name} (self)"
  672                 : 'Self',
  673         ), "<BR></TD></TR><TR><TD VALIGN=TOP>\n";
  674 
  675     if (@non_block_values) {
  676         my @nb_disable;
  677         if ($disable ne 'block') {
  678             @nb_disable = (-disabled => \@non_block_values);
  679         }
  680         print "<B>non-block reservation types</B><BR>\n",
  681             $q->checkbox_group(
  682                 -name       => 'rt_non_block',
  683                 -values     => \@non_block_values,
  684                 -default    => \@default_non_block,
  685                 -labels     => $non_block_labels,
  686                 -linebreak  => 'true',
  687                 @nb_disable,
  688             );
  689     }
  690     print "</TD><TD VALIGN=TOP>\n";
  691     if (@block_values) {
  692         my @b_disable;
  693         if ($disable eq 'block') {
  694             @b_disable = (-disabled => \@block_values);
  695         }
  696         print "<B>block reservation types</B><BR>\n",
  697             $q->checkbox_group(
  698                 -name       => 'rt_block',
  699                 -values     => \@block_values,
  700                 -default    => \@default_non_block,
  701                 -labels     => $block_labels,
  702                 -linebreak  => 'true',
  703                 @b_disable,
  704             ), "<BR>\n";
  705     }
  706     print "</TD></TR></TABLE>\n";
  707 }
  708 
  709 #---------------------------------------------------------------
  710 # MODIFY TYPE
  711 #---------------------------------------------------------------
  712 
  713 sub mainModifyTypeForm
  714 {
  715     my $q = shift;
  716 
  717     print "<HR>\n";
  718 
  719     print $q->h1('Modify a Reservation Type');
  720     print $q->start_form(-name => 'ModifyType');
  721     print "Type";
  722     makeTypePopup($q);
  723     print "&nbsp;";
  724     print $q->submit(action => 'Modify Type');
  725     print $q->end_form();
  726 
  727     print "<HR>\n";
  728 }
  729 
  730 #---------------------------------------------------------------
  731 # DEACTIVATE TYPE
  732 #---------------------------------------------------------------
  733 
  734 sub mainDeactivateTypeForm
  735 {
  736     my $q = shift;
  737 
  738     print $q->h1('Deactivate a Reservation Type');
  739     print $q->start_form(-name => 'DeactivateType');
  740     print "Type";
  741     makeTypePopup($q);
  742     print "&nbsp;";
  743     print $q->submit(action => 'Deactivate Type');
  744     print $q->end_form();
  745 
  746     print "<HR>\n";
  747 }
  748 
  749 sub mainReactivateTypeForm
  750 {
  751     my $q = shift;
  752 
  753     print $q->h1('Reactivate a Reservation Type');
  754     print $q->start_form(-name => 'ReactivateType');
  755     print "Type";
  756     makeTypePopup($q, '-reactivate');
  757     print "&nbsp;";
  758     print $q->submit(action => 'Reactivate Type');
  759     print $q->end_form();
  760 
  761     print "<HR>\n";
  762 }
  763 
  764 sub makeTypePopup
  765 {
  766     my ($q, $arg) = @_;
  767 
  768     my @types;
  769     if ($arg eq '-reactivate') {
  770         @types = AbsenceDB::getTypes('invalid');
  771     } else {
  772         @types = AbsenceDB::getTypes();
  773     }
  774 
  775     my $labref;
  776     my @ids;
  777     foreach my $type_ref (@types) {
  778         $labref->{ $type_ref->{id} } = $type_ref->{name};
  779         push(@ids, $type_ref->{id});
  780     }
  781 
  782     my @sorted = sort {lc($labref->{ $a }) cmp lc($labref->{ $b })} @ids;
  783     print $q->popup_menu(
  784         -name       => 'type_id',
  785         -values     => \@sorted,
  786         -labels     => $labref,
  787     );
  788 }
  789 
  790 sub formColorToDbColor
  791 {
  792     my $form_color = shift;
  793 
  794         my ($r, $g, $b) = ($form_color =~ /^(..)(..)(..)$/);
  795         $r = hex($r);
  796         $g = hex($g);
  797         $b = hex($b);
  798 
  799         return ($r, $g, $b);
  800 }
  801 
  802 sub dbColorToFormColor
  803 {
  804     my $tref = shift;
  805 
  806     return sprintf("%02x%02x%02x",
  807         $tref->{color_red},
  808         $tref->{color_green},
  809         $tref->{color_blue},
  810     );
  811 }
  812 
  813 sub addType
  814 {
  815     my $q = shift;
  816 
  817     dbg("- add type -");
  818 
  819     if (!$SUPER_USER) {
  820         abslog("attempt to circumvent security (addType)");
  821         reloadDisplay($q, 'Error adding type', 'security breach thwarted');
  822     }
  823 
  824     if (length($Q::name) == 0) {
  825         dbg("looks bad");
  826         reloadDisplay($q, 'Error adding type', 'You must supply a name.');
  827     }
  828 
  829     if (defined(AbsenceDB::queryTypeName($Q::name))) {
  830         dbg("looks bad");
  831         reloadDisplay(
  832             $q,
  833             'Error modifying type',
  834             "name [$Q::name] already in use by an active type",
  835         );
  836     }
  837 
  838     if (defined(AbsenceDB::queryTypeName($Q::name, 'invalid'))) {
  839         dbg("looks bad");
  840         reloadDisplay(
  841             $q,
  842             'Error modifying type',
  843             "name [$Q::name] already in use by an inactive type",
  844         );
  845     }
  846 
  847     my $ref = { name => $Q::name };
  848 
  849     if (defined($Q::description)) {
  850         $ref->{description} = $Q::description;
  851     }
  852 
  853     if (length($Q::color) == 6) {
  854         ($ref->{color_red}, $ref->{color_green}, $ref->{color_blue})
  855             = formColorToDbColor($Q::color);
  856     } else {
  857         $ref->{color_red}   = 0;
  858         $ref->{color_green} = 0;
  859         $ref->{color_blue}  = 0;
  860     }
  861 
  862     $ref->{default_type} = ($Q::default_type eq 'on') ? 'TRUE' : 'FALSE';
  863 
  864     $ref->{skip_non_workdays}
  865         = ($Q::skip_non_workdays eq 'on') ? 'TRUE' : 'FALSE';
  866 
  867     if (defined($Q::height)) {
  868         $ref->{height} = $Q::height;
  869     }
  870 
  871     if (defined($Q::priority)) {
  872         $ref->{priority} = $Q::priority;
  873     }
  874 
  875     $ref->{transparency} = $Q::transparency;
  876 
  877     my $new_id = AbsenceDB::addType($ref);
  878     abslog("addType: \n".Dumper($ref));
  879     dbg("looks good");
  880     AbsenceDB::setTypeModTime();
  881 
  882     # now worry about coincidence rules
  883     if ($MULTI_RES) {
  884         my @no_coincidence = ($Q::height eq 'block')
  885             ? @Q::rt_block
  886             : @Q::rt_non_block;
  887         ($Q::self_coincidence eq 'on') && push(@no_coincidence, $new_id);
  888         foreach my $id (@no_coincidence) {
  889             AbsenceDB::vorbidTypeCoincidence($new_id, $id);
  890         }
  891     }
  892 
  893     reloadTop($q, 'Type Successfully Added', '_top',
  894         'Finished. Click on button below to reload top page');
  895     exit;
  896 }
  897 
  898 sub modifyTypeForm
  899 {
  900     my $q = shift;
  901 
  902     my $tref = AbsenceDB::getType($Q::type_id);
  903     #abslog("dump of tref:\n".Dumper($tref)."\n--done--");
  904 
  905     if (!defined($tref)) {
  906         reloadTop($q, "Modify Type $Q::type_id", 'display',
  907             "Modify Type $Q::type_id", 'display',
  908             'Type disappeared');
  909     }
  910 
  911     my $color = dbColorToFormColor($tref);
  912 
  913     print $q->header(-expires => '-1d');
  914     print $q->start_html(
  915         -title      => "Absence: Modify Type $tref->{name}",
  916         -target     => 'display',
  917         -BGCOLOR    => $COLOR_MANAGE,
  918         -script     => $JS_COLOR,
  919     );
  920 
  921     includeJsRtCoincidenceScript();
  922     print "color=[$color]<BR>\n";
  923     print $q->h1('Modify a Reservation Type');
  924     print $q->start_form(-name => 'modify_type');
  925     print $q->hidden(-name => 'type_id', -default => $Q::type_id);
  926     if ($MULTI_RES) { print "<TABLE><TR><TD VALIGN=TOP>\n"; }
  927     print "<TABLE>\n";
  928     print "<TR><TH ALIGN=right>Type Name</TH>\n<TD>\n";
  929     print $q->textfield(
  930         -name       => 'name',
  931         -size       => 20,
  932         -maxlength  => 20,
  933         -value      => $tref->{name},
  934     );
  935     print "</TD></TR>\n";
  936     print "<TR><TH ALIGN=right>Description</TH>\n<TD>\n";
  937     print $q->textfield(
  938         -name       => 'description',
  939         -size       => 40,
  940         -maxlength  => 60,
  941         -value      => $tref->{description},
  942     );
  943     print "</TD></TR>\n";
  944     print "<TR><TH ALIGN=right>Color</TH>\n<TD>\n",
  945         $q->textfield(
  946             -name       => 'color',
  947             -size       => 8,
  948             -maxlength  => 8,
  949             -class      => 'color',
  950             -value      => $color,
  951         );
  952 
  953     if ($MULTI_RES) {
  954         my $trans = defined($tref->{transparency})
  955             ? $tref->{transparency}
  956             : 0;
  957         print "</TD></TR><TR><TH ALIGN=right>Transparency</TH><TD>\n",
  958             $q->popup_menu(
  959                 -name       => 'transparency',
  960                 -values     => [0..100],
  961                 -default    => $trans,
  962             );
  963     }
  964 
  965     print "</TD></TR>\n",
  966         "<TR><TH ALIGN=right>Default Type</TH>\n<TD>\n",
  967         $q->checkbox(
  968             -name       => 'default_type',
  969             -checked    => $tref->{default_type},
  970             -value      => 'on',
  971             -label      => 'Default Type',
  972         ),
  973         "</TD></TR>\n",
  974         "<TR><TH ALIGN=right>Skip Non Workdays</TH>\n<TD>\n",
  975         $q->checkbox(
  976             -name       => 'skip_non_workdays',
  977             -checked    => $tref->{skip_non_workdays},
  978             -value      => 'on',
  979             -label      => 'Skip Non Workdays',
  980         );
  981 
  982     if ($MULTI_RES) {
  983         my $prio = defined($tref->{priority}) ? $tref->{priority} : 1;
  984         print "\n</TD></TR>\n<TR><TH ALIGN=right>Height</TH>\n<TD>\n",
  985             makeTypeHeightPopup($q, 'document.modify_type', $tref->{height}),
  986             "\n</TD></TR>\n<TR><TH ALIGN=right>Priority</TH>\n<TD>\n",
  987             $q->popup_menu(
  988                 -name       => 'priority',
  989                 -values     => [reverse(-10..-1,1..10)],
  990                 -default    => $prio,
  991             );
  992         print "</TD></TR>\n";
  993         print "</TD></TR></TABLE>\n";
  994         print "</TD><TD>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</TD>\n<TD>\n";
  995         my @no_coincidence = AbsenceDB::getTypeCoincidence($tref->{id});
  996         $DEBUG && abslog("no_coincidence=[".join('/', @no_coincidence)."]");
  997         my $disable_def = $tref->{height} eq 'block' ? 'full' : 'block';
  998         makeCoincidenceCheckboxes(
  999             $q,
 1000             $Q::type_id,
 1001             \@no_coincidence,
 1002             $disable_def
 1003         );
 1004     }
 1005 
 1006     print "</TD></TR><TABLE>\n";
 1007 
 1008     print $q->submit(action => 'Submit Type Modification');
 1009     print $q->end_form();
 1010     exit;
 1011 }
 1012 
 1013 sub modifyType
 1014 {
 1015     my $q = shift;
 1016 
 1017     if (!$SUPER_USER) {
 1018         abslog("attempt to circumvent security (modifyType)");
 1019         reloadDisplay($q, 'Error modifying type', 'security breach thwarted');
 1020     }
 1021 
 1022     dbg("- modify type -");
 1023     if (length($Q::name) == 0) {
 1024         dbg("looks bad");
 1025         reloadDisplay($q, 'Error modifying type', 'You must supply a name.');
 1026     }
 1027 
 1028     if ($Q::color !~ /^[0-9a-f]+$/i) {
 1029         dbg("looks bad");
 1030         reloadDisplay($q, 'Error modifying type', 'color-value invalid.');
 1031     }
 1032 
 1033     if (defined(AbsenceDB::queryTypeName($Q::name, 'valid', $Q::type_id))) {
 1034         dbg("looks bad");
 1035         reloadDisplay(
 1036             $q,
 1037             'Error modifying type',
 1038             "name [$Q::name] already in use by an active type",
 1039         );
 1040     }
 1041 
 1042     if (defined(AbsenceDB::queryTypeName($Q::name, 'invalid', $Q::type_id))) {
 1043         dbg("looks bad");
 1044         reloadDisplay(
 1045             $q,
 1046             'Error modifying type',
 1047             "name [$Q::name] already in use by an inactive type",
 1048         );
 1049     }
 1050 
 1051     my $ref = { name => $Q::name, id => $Q::type_id };
 1052 
 1053     if (defined($Q::description)) {
 1054         $ref->{description} = $Q::description;
 1055     }
 1056 
 1057     if (length($Q::color) == 6) {
 1058         ($ref->{color_red}, $ref->{color_green}, $ref->{color_blue})
 1059             = formColorToDbColor($Q::color);
 1060     } else {
 1061         $ref->{color_red}   = 0;
 1062         $ref->{color_green} = 0;
 1063         $ref->{color_blue}  = 0;
 1064     }
 1065 
 1066     $DEBUG && abslog("default_type=[$Q::default_type], skip=[$Q::skip_non_workdays]");
 1067 
 1068     $ref->{default_type}
 1069         = ($Q::default_type eq 'on') ? 'TRUE' : 'FALSE';
 1070 
 1071     $ref->{skip_non_workdays}
 1072         = ($Q::skip_non_workdays eq 'on') ? 'TRUE' : 'FALSE';
 1073 
 1074     if (defined($Q::height)) {
 1075         $ref->{height} = $Q::height;
 1076     }
 1077 
 1078     if (defined($Q::priority)) {
 1079         $ref->{priority} = $Q::priority;
 1080     }
 1081 
 1082     $ref->{transparency} = $Q::transparency;
 1083 
 1084     #abslog("new transparency = [$Q::transparency]");
 1085 
 1086     #dbg("--dump of ref about to be passed to modifyType:\n".Dumper($ref)."\n--end--\n");
 1087     my $ret = AbsenceDB::modifyType($ref);
 1088     abslog("Type Modified:\n".Dumper($ref));
 1089 
 1090     # now worry about coincidence rules
 1091     if ($MULTI_RES) {
 1092         AbsenceDB::purgeTypeCoincidenceEntries($Q::type_id);
 1093         my @no_coincidence = ($Q::height eq 'block')
 1094             ? @Q::rt_block
 1095             : @Q::rt_non_block;
 1096         ($Q::self_coincidence eq 'on') && push(@no_coincidence, $Q::type_id);
 1097         foreach my $id (@no_coincidence) {
 1098             AbsenceDB::vorbidTypeCoincidence($Q::type_id, $id);
 1099         }
 1100     }
 1101 
 1102     dbg("looks good");
 1103     AbsenceDB::setTypeModTime();
 1104     #AbsenceImage::removeLegendFile();
 1105     #AbsenceImage::removeMonthImages();
 1106     reloadTop($q, 'Type Successfully Modified', '_top',
 1107         'Finished. Click on button below to reload top page');
 1108     exit;
 1109 }
 1110 
 1111 sub deactivateType
 1112 {
 1113     my $q = shift;
 1114 
 1115     dbg("- deactivate type -");
 1116 
 1117     if (!$SUPER_USER) {
 1118         abslog("attempt to circumvent security (deactivateType)");
 1119         reloadDisplay($q, 'Error deactivating type', 'security breach thwarted');
 1120     }
 1121 
 1122     my $ret = AbsenceDB::deactivateType($Q::type_id);
 1123     abslog("Type Deactivated. ID=$Q::type_id");
 1124     dbg("looks good");
 1125     AbsenceDB::setTypeModTime();
 1126     #AbsenceImage::removeLegendFile();
 1127     #AbsenceImage::removeMonthImages();
 1128     reloadTop($q, 'Type Successfully Deactivated', '_top',
 1129         'Finished. Click on button below to reload top page');
 1130     exit;
 1131 }
 1132 
 1133 sub reactivateType
 1134 {
 1135     my $q = shift;
 1136 
 1137     dbg("- reactivate type -");
 1138 
 1139     if (!$SUPER_USER) {
 1140         abslog("attempt to circumvent security (reactivateType)");
 1141         reloadDisplay($q, 'Error deactivating type', 'security breach thwarted');
 1142     }
 1143 
 1144     # ROBBO
 1145     my $res = validate_input([
 1146         type        => [ num => $Q::type_id ],
 1147     ]);
 1148     if ($res) {
 1149             reloadDisplay($q, 'Error reactivating type', $res);
 1150     }
 1151 
 1152     my $ret = AbsenceDB::reactivateType($Q::type_id);
 1153     abslog("Type Reactivated. ID=$Q::type_id");
 1154     dbg("looks good");
 1155     AbsenceDB::setTypeModTime();
 1156     #AbsenceImage::removeLegendFile();
 1157     #AbsenceImage::removeMonthImages();
 1158     reloadTop($q, 'Type Successfully Deactivated', '_top',
 1159         'Finished. Click on button below to reload top page');
 1160     exit;
 1161 }
 1162 
 1163 #---------------------------------------------------------------
 1164 # ADD USER
 1165 #---------------------------------------------------------------
 1166 
 1167 sub mainAddUserForm
 1168 {
 1169     my $q = shift;
 1170 
 1171     print $q->h1('Add a user');
 1172     print qq[<P>A "user" is purely an authentication object, with no
 1173         object associated with it.<P>];
 1174 
 1175     # ROBBO
 1176     print $q->start_form(
 1177         -name       => 'add_user',
 1178         -onSubmit   => 'return validate(document.add_user);',
 1179     );
 1180     print "<TABLE>\n";
 1181 
 1182     #------------------------
 1183     # Username
 1184     #------------------------
 1185     print "<TR><TH ALIGN=right>Username</TH><TD>\n";
 1186     print $q->textfield(
 1187         -name       => 'username',
 1188         -size       => 20,
 1189         -maxlength  => 20,
 1190     );
 1191     print "</TD><TD>[This is the login-name]</TD></TR>\n";
 1192 
 1193 
 1194     if ($MANAGE_PASSWORD) {
 1195         #------------------------
 1196         # password
 1197         #------------------------
 1198         if ($MANAGE_PASSWORD) {
 1199             print "<TR><TH ALIGN=right>Password</TH><TD>\n";
 1200             print $q->textfield(
 1201                 -name       => 'password',
 1202                 -size       => 30,
 1203                 -maxlength  => 30,
 1204             );
 1205             print "</TD></TR>\n";
 1206         }
 1207     }
 1208 
 1209     aclForm($q, 'add_user');
 1210 
 1211     print "</TABLE>\n";
 1212     print $q->submit(action => 'Add User');
 1213     print $q->end_form();
 1214     print "<HR>\n";
 1215 }
 1216 
 1217 sub addUser
 1218 {
 1219     my $q = shift;
 1220 
 1221     dbg("- add user -");
 1222 
 1223     if (!length($Q::username)) {
 1224         dbg("looks bad");
 1225         reloadDisplay($q, 'Error adding person', 'You must specify a Username.');
 1226     }
 1227 
 1228     if ($Q::username eq 'self') {
 1229         dbg("looks bad");
 1230         reloadDisplay($q, 'Error adding person', 'Username must not be "self".');
 1231     }
 1232 
 1233     if ($Q::username =~ /\s/) {
 1234         dbg("looks bad");
 1235         reloadDisplay($q, 'Error adding person',
 1236             'User-ID must not have any spaces or tabs in it.');
 1237     }
 1238 
 1239     if ($MANAGE_PASSWORD && !length($Q::password)) {
 1240         dbg("looks bad: no password supplied");
 1241         reloadDisplay($q, 'Error adding person', 'You must specify a Password.');
 1242     }
 1243 
 1244     my $res = validate_input([
 1245         username    => $Q::username,
 1246         acl     => \@Q::group_acl,
 1247         acl     => \@Q::person_acl,
 1248     ]);
 1249     if ($res) {
 1250             reloadDisplay($q, 'Error adding user', $res);
 1251     }
 1252 
 1253 
 1254     # ROBBO: big work here
 1255     $DEBUG && abslog("from form: pacl=[".join('/', @Q::person_acl).
 1256         "], gacl=[".join('/', @Q::group_acl).']');
 1257 
 1258     my ($pacl, $gacl) = convertAcl(\@Q::person_acl, \@Q::group_acl);
 1259     if (!checkAcls($pacl, $gacl, 'add-user')) {
 1260         dbg("looks bad: acl violation");
 1261         reloadDisplay($q, 'Error adding person', 'Invalid person/groups');
 1262     }
 1263 
 1264     my @params = ($Q::username, $Q::password, $pacl, $gacl);
 1265 
 1266     dbg("params=(".join(',',@params).")");
 1267     my $ret = AbsenceDB::addUser(@params);
 1268     dbg("ret = [$ret]");
 1269 
 1270     if ($ret eq 'ok') {
 1271         dbg("looks good");
 1272         print $q->redirect($MAIN_SCRIPT);
 1273     } elsif ($ret =~ /^baddata:\s(.*)$/) {
 1274         dbg("looks bad");
 1275         reloadDisplay($q, 'Error adding user',
 1276             $1);
 1277     } elsif ($ret eq 'duplicate') {
 1278         dbg("looks bad");
 1279         reloadDisplay($q, 'Error adding user',
 1280             "user-ID [$Q::username] already exists in system");
 1281     }
 1282 
 1283     exit;
 1284 }
 1285 
 1286 sub mainModifyUserForm
 1287 {
 1288     my $q = shift;
 1289 
 1290     print $q->h1('Modify a user');
 1291     print $q->start_form;
 1292     print "User";
 1293     makeUsersPopup($q, 'modify');
 1294     print "&nbsp;";
 1295     print $q->submit(action => 'Modify User');
 1296     print $q->end_form();
 1297     print "<HR>\n";
 1298 }
 1299 
 1300 sub modifyUserForm
 1301 {
 1302     my $q = shift;
 1303 
 1304     my $uref = AbsenceDB::getUser(id => $Q::user_id);
 1305 
 1306     if (!defined($uref)) {
 1307         reloadDisplay($q, 'Error modifying user', 'User disappeared.');
 1308     }
 1309 
 1310     print $q->header(-expires => '-1d');
 1311     print $q->start_html(
 1312         -title      => "Absence: Modify $uref->{username}",
 1313         -target     => 'display',
 1314         -BGCOLOR    => $COLOR_MANAGE,
 1315     );
 1316 
 1317     includeJsAclScript();
 1318     print $q->h1("Modify $uref->{username}");
 1319 
 1320     print $q->start_form(
 1321         -method     => 'POST',
 1322         -name       => 'mod_user',
 1323         -onSubmit   => 'return validate(document.mod_user);',
 1324     );
 1325 
 1326     print "<TABLE>\n";
 1327 
 1328     #---------------------------------------------
 1329     # User-Name
 1330     #---------------------------------------------
 1331     print qq[<TR><TH ALIGN=right>User-ID</TH><TD BGCOLOR="#bbbbbb">\n];
 1332     print $q->hidden(-name => 'uid', -default => $Q::user_id);
 1333     print "$uref->{username}";
 1334     print "</TD>\n";
 1335     print "<TD>[login-name]</TD>\n";
 1336     print "</TR>\n";
 1337 
 1338     #------------------------
 1339     # password
 1340     #------------------------
 1341     if ($MANAGE_PASSWORD) {
 1342         print "<TR><TH ALIGN=right>Password</TH><TD>\n";
 1343         print $q->textfield(
 1344             -name       => 'password',
 1345             -size       => 30,
 1346             -maxlength  => 30,
 1347             -value      => $uref->{password},
 1348         );
 1349         print "</TD><TD>[to change password, clear and enter new password]</TR>\n";
 1350     }
 1351 
 1352     aclForm($q, 'mod_user', $Q::user_id);
 1353 
 1354     print "</TABLE>\n";
 1355 
 1356     print $q->submit(action => 'Submit User Modification');
 1357     print $q->end_form();
 1358     print $q->end_html();
 1359     exit;
 1360 }
 1361 
 1362 sub modifyUser
 1363 {
 1364     my $q = shift;
 1365 
 1366     dbg("- modify user -");
 1367 
 1368     if (!length($Q::uid)) {
 1369         dbg("looks bad");
 1370         reloadDisplay($q, 'Error modifying user',
 1371             'User-ID field must not be blank.');
 1372     }
 1373 
 1374     if ($MANAGE_PASSWORD && !length($Q::password)) {
 1375         dbg("looks bad: no password supplied");
 1376         reloadDisplay($q, 'Error adding user',
 1377             'You must specify a Password.');
 1378     }
 1379 
 1380     my $res = validate_input([
 1381         uid     => [ num    => $Q::uid ],
 1382         acl => \@Q::group_acl,
 1383         acl => \@Q::person_acl,
 1384     ]);
 1385     if ($res) {
 1386             reloadDisplay($q, 'Error modifying user', $res);
 1387     }
 1388 
 1389     # ROBBO: add check whether $AUTH_UID is allowed to modify
 1390     # $Q::uid
 1391 
 1392     my $oldinfo = AbsenceDB::getUser(id => $Q::uid);
 1393 
 1394     if (!defined($oldinfo)) {
 1395         reloadDisplay($q, 'Error modifying user',
 1396             "user-id [$Q::uid] disappeared.");
 1397     }
 1398 
 1399     dbg("pacl=[".join(',',@Q::person_acl)."]");
 1400     dbg("gacl=[".join(',',@Q::group_acl)."]");
 1401     my ($pacl, $gacl) = convertAcl(\@Q::person_acl, \@Q::group_acl);
 1402     #dbg("(converted) pacl=[".join(',',@{$pacl})."]");
 1403     #dbg("(converted) gacl=[".join(',',@{$gacl})."]");
 1404     dumpAcl("modifyUser: uid=$Q::uid, after convert:",
 1405         {p => $pacl, g => $gacl});
 1406     if (!checkAcls($pacl, $gacl, 'mod-user', $Q::uid)) {
 1407         dbg("looks bad: acl violation");
 1408         reloadDisplay($q, 'Error adding user', 'Invalid person/groups');
 1409     }
 1410 
 1411     recombineAcls($Q::uid, $pacl, $gacl);
 1412     dumpAcl("modifyUser: uid=$Q::uid, after recombine:",
 1413         {p => $pacl, g => $gacl});
 1414     my @params = ($Q::uid, $Q::password, $pacl, $gacl);
 1415 
 1416     my $ret = AbsenceDB::modifyUser(@params);
 1417 
 1418     dbg("ret = [$ret]");
 1419 
 1420     if ($ret eq 'ok') {
 1421         dbg("looks good");
 1422         print $q->redirect($MAIN_SCRIPT);
 1423         exit;
 1424     } elsif ($ret =~ /^baddata:\s(.*)$/) {
 1425         dbg("looks bad");
 1426         reloadDisplay($q, 'Error modifying user',
 1427             $1);
 1428     } else {
 1429         dbg("looks bad");
 1430         abslog("error modifying user [$oldinfo->{username}] ret = [$ret]");
 1431         reloadDisplay($q, 'Error modifying user',
 1432             "modify-user [$oldinfo->{username}] failed.");
 1433     }
 1434 }
 1435 
 1436 sub mainDeleteUserForm
 1437 {
 1438     my $q = shift;
 1439 
 1440     print $q->h1('Delete a user');
 1441     print $q->start_form;
 1442     print "User";
 1443     makeUsersPopup($q, 'delete');
 1444 
 1445     print '&nbsp;';
 1446     print $q->submit(action => 'Delete User');
 1447     print $q->end_form();
 1448 
 1449     print "<HR>\n";
 1450 }
 1451 
 1452 sub deleteUser
 1453 {
 1454     my $q = shift;
 1455 
 1456     my $res = validate_input([
 1457         user_id => [ num    => $Q::user_id ],
 1458     ]);
 1459     if ($res) {
 1460             reloadDisplay($q, 'Error deleting user', $res);
 1461     }
 1462 
 1463     my $u_ref = AbsenceDB::getUser(id => $Q::user_id);
 1464     my $ret = AbsenceDB::deleteUser($Q::user_id);
 1465     if ($ret eq 'ok') {
 1466         abslog("deleteUser: username=[$u_ref->{username}]");
 1467         print $q->redirect($MAIN_SCRIPT);
 1468     } elsif ($ret eq 'bad-id') {
 1469         reloadDisplay($q, 'Error deleting user',
 1470             'User was deleted by someone else');
 1471     }
 1472     exit;
 1473 }
 1474 
 1475 #=================================================================
 1476 #=================================================================
 1477 #=================================================================
 1478 
 1479 sub makeUsersPopup
 1480 {
 1481     my ($q, $op) = @_;
 1482 
 1483     my @users = AbsenceAuthorization::getAdminUsers($AUTH_UID, $op);
 1484 
 1485     my %labels = map { $_ => AbsenceDB::getUser(id => $_, 'username') } @users;
 1486 
 1487     print $q->popup_menu(
 1488         -name   => 'user_id',
 1489         -values => [sort { $labels{$a} cmp $labels{$b} } @users],
 1490         -labels => \%labels,
 1491     );
 1492 }
 1493 
 1494 sub makePeoplePopup
 1495 {
 1496     my ($q, $op) = @_;
 1497 
 1498     my @pids = AbsenceAuthorization::getAdminPeople($AUTH_UID, $op);
 1499     #abslog("makePeoplePopup: pids=[".join(',', @pids)."]");
 1500 
 1501     my $labref;
 1502     foreach my $pid (@pids) {
 1503         $labref->{$pid} = AbsenceDB::getPerson($pid, 'name');
 1504     }
 1505 
 1506     my @sorted = sort {lc($labref->{$a}) cmp lc($labref->{$b})} @pids;
 1507 
 1508     print $q->popup_menu(
 1509         -name   => 'person_id',
 1510         -values => \@sorted,
 1511         -labels => $labref,
 1512     );
 1513 }
 1514 
 1515 sub removeMonthImages
 1516 {
 1517     my (@list) = @_;
 1518 
 1519     my $dh;
 1520     opendir($dh, $IMAGE_DIR) || die "opendir [$IMAGE_DIR]";
 1521     
 1522     my $it = AbsenceConfig::fetch('image_type');
 1523     my $file;
 1524     my $re = '('.join('|',@list).')';
 1525     while($_ = readdir($dh)) {
 1526         if ((@list && /^absence-${re}-.*\.$it$/) ||
 1527             (!@list && /^absence-.*\.$it$/))
 1528         {
 1529             $file = "$IMAGE_DIR/$_";
 1530             dbg("unlinking [$file]");
 1531             unlink($file) || dbg("failed: $!");
 1532             my $map = $file;
 1533             $map =~ s/\.$it$/.map/;
 1534             -f $map && unlink($map) || dbg("failed to unlink map file: $!");
 1535         }
 1536     }
 1537     closedir($dh);
 1538 }
 1539 
 1540 #=================================================================
 1541 # add a group
 1542 #=================================================================
 1543 
 1544 sub addGroup
 1545 {
 1546     my $q = shift;
 1547 
 1548     dbg("- add group -");
 1549 
 1550     if (!$SUPER_USER) {
 1551         abslog("attempt to circumvent security (addGroup)");
 1552         reloadDisplay($q, 'Error adding group', 'security breach thwarted');
 1553     }
 1554 
 1555     if (length($Q::name) == 0) {
 1556         dbg("looks bad");
 1557         reloadDisplay($q, 'Error adding group', 'You must supply a name.');
 1558     }
 1559 
 1560     if ($Q::name =~ /^(all|self)$/i) {
 1561         dbg("looks bad");
 1562         reloadDisplay($q, 'Error adding group', 'The name must not be "self" or "all".');
 1563     }
 1564 
 1565     my $res = validate_input([
 1566         name            => $Q::name,
 1567         description     => $Q::description,
 1568     ]);
 1569     if ($res) {
 1570             reloadDisplay($q, 'Error adding group', $res);
 1571     }
 1572 
 1573     my $ret = AbsenceDB::addGroup('new', $Q::name, $Q::pass, $Q::description);
 1574     dbg("ret = [$ret]");
 1575 
 1576     if ($ret eq 'ok') {
 1577         dbg("looks good");
 1578         reloadTop($q, 'Group Successfully Added', '_top',
 1579             'Finished. Click on button below to reload top page');
 1580     } elsif ($ret eq 'duplicate') {
 1581         dbg("looks bad");
 1582         reloadDisplay($q, 'Error adding group',
 1583             "[$Q::name] already exists in system");
 1584     } elsif ($ret =~ /^baddata:\s(.*)$/) {
 1585         dbg("looks bad");
 1586         reloadDisplay($q, 'Error adding group',
 1587             $1);
 1588     } else {
 1589         dbg("looks bad");
 1590         reloadDisplay($q, 'Error adding group',
 1591             "[$Q::name] was deleted by someone else");
 1592     }
 1593     exit;
 1594 }
 1595 
 1596 sub deleteGroup
 1597 {
 1598     my $q = shift;
 1599 
 1600     dbg("- delete group -");
 1601 
 1602     if (!$SUPER_USER) {
 1603         abslog("attempt to circumvent security (deleteGroup)");
 1604         reloadDisplay($q, 'Error deleting group', 'security breach thwarted');
 1605     }
 1606 
 1607     my $res = validate_input([
 1608         group_id    => [ num    => $Q::group_id ],
 1609     ]);
 1610     if ($res) {
 1611             reloadDisplay($q, 'Error deleting group', $res);
 1612     }
 1613 
 1614     my $ret = AbsenceDB::deleteGroup($Q::group_id);
 1615     dbg("ret = [$ret]");
 1616 
 1617     if ($ret eq 'ok') {
 1618         dbg("looks good");
 1619         AbsenceImage::removeMonthImages($Q::group_id);
 1620         reloadTop($q, 'Group Successfully Deleted', '_top',
 1621             'Finished. Click on button below to reload top page');
 1622     } else {
 1623         dbg("looks bad");
 1624         reloadTop($q, 'Error deleting group', 'display',
 1625             'someone deleted the group before you.');
 1626     }
 1627     exit;
 1628 }
 1629 
 1630 #=================================================================
 1631 # add a person
 1632 #=================================================================
 1633 
 1634 sub addPerson
 1635 {
 1636     my $q = shift;
 1637 
 1638     dbg("- add person -");
 1639 
 1640     if (length($Q::name) == 0) {
 1641         dbg("looks bad");
 1642         reloadDisplay($q, 'Error adding person', 'You must supply a name.');
 1643     }
 1644 
 1645     if ($Q::name eq 'self') {
 1646         dbg("looks bad");
 1647         reloadDisplay($q, 'Error adding person', 'Name must not be "self".');
 1648     }
 1649 
 1650     if ($AUTH && $OAP) {
 1651         if (!length($Q::username)) {
 1652             dbg("looks bad");
 1653             reloadDisplay($q, 'Error adding person', 'You must specify a Username.');
 1654         }
 1655 
 1656         if ($MANAGE_PASSWORD && !length($Q::password)) {
 1657             dbg("looks bad: no password supplied");
 1658             reloadDisplay($q, 'Error adding person',
 1659                 'You must specify a Password.');
 1660         }
 1661     }
 1662 
 1663     my @grps = ($GROUP_POLICY eq 'single') ? ($Q::group_id) : @Q::group_ids;
 1664 
 1665     my $res = validate_input([
 1666         name        => $Q::name,
 1667         username    => $Q::username,
 1668         email       => $Q::email,
 1669         group_id    => [ num    => \@grps ],
 1670         acl     => \@Q::group_acl,
 1671         acl     => \@Q::person_acl,
 1672     ]);
 1673     if ($res) {
 1674             reloadDisplay($q, 'Error adding person', $res);
 1675     }
 1676 
 1677     if (!checkGroups(@grps)) {
 1678         dbg("looks bad: acl violation");
 1679         reloadDisplay($q, 'Error adding person', 'Invalid group membership');
 1680     }
 1681 
 1682     my @params = ('new', $Q::name, $Q::username, $Q::email, \@grps);
 1683     if ($OAP && $AUTH) {
 1684         my ($pacl, $gacl) = convertAcl(\@Q::person_acl, \@Q::group_acl);
 1685         if (!checkAcls($pacl, $gacl, 'add-person')) {
 1686             dbg("looks bad: acl violation");
 1687             reloadDisplay($q, 'Error adding person', 'Invalid person/groups');
 1688         }
 1689         push(@params, $Q::password, $pacl, $gacl);
 1690     }
 1691 
 1692     dbg("params=(".join(',',@params).")");
 1693     my $ret = AbsenceDB::addPerson(@params);
 1694     dbg("ret = [$ret]");
 1695 
 1696     if ($ret eq 'ok') {
 1697         dbg("looks good");
 1698         print $q->redirect($MAIN_SCRIPT);
 1699         foreach my $gid (@grps) {
 1700             AbsenceImage::removeMonthImages($gid);
 1701         }
 1702     } elsif ($ret =~ /^duplicate/) {
 1703         dbg("looks bad");
 1704         if ($ret eq 'duplicate-name') {
 1705             reloadDisplay($q, 'Error adding person',
 1706                 "[$Q::name] already exists in system");
 1707         } else {
 1708             reloadDisplay($q, 'Error adding person',
 1709                 "user-nameID [$Q::username] already exists in system");
 1710         }
 1711     } else {
 1712         reloadDisplay($q, 'Error adding person', "unknown error occurred.");
 1713     }
 1714     exit;
 1715 }
 1716 
 1717 # ROBBO: hmm
 1718 sub recombineAcls
 1719 {
 1720     my ($uid, $pacl, $gacl) = @_;
 1721 
 1722     $SUPER_USER && return ($pacl, $gacl);
 1723 
 1724     my ($gvisref, $ginvref, $pvisref, $pinvref) = ([], [], [], []);
 1725     my $uref = AbsenceDB::getUser(id => $uid);
 1726     if (defined($uref)) {
 1727         my $acls = AbsenceDB::getUserAcls($uid);
 1728         ($gvisref, $ginvref) = AbsenceAuthorization::divideGroupAcls(
 1729             $AUTH_UID,
 1730             $uid,
 1731             $acls->{group},
 1732         );
 1733         ($pvisref, $pinvref) = AbsenceAuthorization::dividePersonAcls(
 1734             $AUTH_UID,
 1735             $acls->{object},
 1736         );
 1737     }
 1738 
 1739     push(@{$pacl}, @{$pinvref});
 1740     push(@{$gacl}, @{$ginvref});
 1741 
 1742 }
 1743 
 1744 sub checkGroups
 1745 {
 1746     my @grps = @_;
 1747 
 1748     $AUTH || return 1;
 1749 
 1750     foreach my $grp (@grps) {
 1751         if (!inListN($grp, \@ADMIN_GROUPS)) {
 1752             return 0;
 1753         }
 1754     }
 1755 
 1756     return 1;
 1757 }
 1758 
 1759 sub checkAcls
 1760 {
 1761     $AUTH || return 1;
 1762     $SUPER_USER && return 1;
 1763 
 1764     my ($paclr, $gaclr, $op, $uid) = @_;
 1765     my @admpeople = AbsenceAuthorization::getAdminPeople($AUTH_UID);
 1766 
 1767     dbg("checkAcls: people");
 1768     foreach my $acl (@{$paclr}) {
 1769         dbg("acl: lev=[$acl->{level}], oid=[$acl->{target}]");
 1770         if ($acl->{target} eq 'self') { next; }
 1771         if (!inListN($acl->{target}, \@admpeople)) {
 1772             dbg("did not find [$acl->{target}] in (".join(',', @admpeople).")");
 1773             return 0;
 1774         }
 1775     }
 1776 
 1777     dbg("checkAcls: groups");
 1778     foreach my $acl (@{$gaclr}) {
 1779         dbg("acl: lev=[$acl->{level}], gid=[$acl->{target}]");
 1780         if ($acl->{target} eq 'self') {
 1781             ($op eq 'mod-person') &&
 1782                 !AbsenceAuthorization::selfAllowed($AUTH_UID, $uid) &&
 1783                     return 0;
 1784             next;
 1785         }
 1786         if ($acl->{target} eq 'all') {
 1787             return 0;
 1788         }
 1789         if (!inListN($acl->{target}, \@ADMIN_GROUPS)) {
 1790             dbg("did not find [$acl->{target}] in (".join(',', @ADMIN_GROUPS).")");
 1791             return 0;
 1792         }
 1793     }
 1794 
 1795     return 1;
 1796 }
 1797 
 1798 sub convertAcl
 1799 {
 1800     my @res;
 1801     for(my $ind = 0; $ind < 2; $ind++) {
 1802         foreach my $acl (@{$_[$ind]}) {
 1803             if ($acl =~ /^(\d+):(.*)$/) {
 1804                 my ($lev, $target) = ($1, $2);
 1805                 push(@{$res[$ind]}, { level => $lev, target => $target });
 1806             } else {
 1807                 die "unable to match [$acl]";
 1808             }
 1809         }
 1810     }
 1811 
 1812     @res;
 1813 }
 1814 
 1815 sub modifyPerson
 1816 {
 1817     my $q = shift;
 1818 
 1819     dbg("- modify person -");
 1820     if (length($Q::name) == 0) {
 1821         dbg("looks bad");
 1822         reloadDisplay($q, 'Error modifying person', 'You must supply a name.');
 1823     }
 1824 
 1825     if ($AUTH && $OAP && !length($Q::username)) {
 1826         dbg("looks bad");
 1827         reloadDisplay($q, 'Error modifying person',
 1828             'Username field must not be blank.');
 1829 
 1830         if ($MANAGE_PASSWORD && !length($Q::password)) {
 1831             dbg("looks bad: no password supplied");
 1832             reloadDisplay($q, 'Error adding person',
 1833                 'You must specify a Password.');
 1834         }
 1835     }
 1836 
 1837     my @grps = ($GROUP_POLICY eq 'single') ? ($Q::group_id) : @Q::group_ids;
 1838 
 1839     #---------------------------------------------------------------
 1840     # checkGroups() makes sure all groups in @grps are in fact
 1841     # administratable by $AUTH_UID
 1842     #---------------------------------------------------------------
 1843     if (!checkGroups(@grps)) {
 1844         dbg("looks bad: acl violation");
 1845         reloadDisplay($q, 'Error adding person', 'Invalid group membership');
 1846     }
 1847 
 1848     dbg("Q::group_ids=[".join(',', @grps)."]");
 1849     my $oldinfo = AbsenceDB::getPerson($Q::person_id);
 1850     if (!defined($oldinfo)) {
 1851         reloadDisplay($q, 'Error modifying person',
 1852             "person [$Q::name] disappeared.");
 1853     }
 1854 
 1855     dbg("modifyPerson: modified group_ids=[".join(',', @grps)."]");
 1856 
 1857     my $uref;
 1858     if ($OAP && $AUTH) {
 1859         # recombine visible and invisible groups
 1860         #my $uref = AbsenceDB::getUser(username => $Q::username);
 1861         $uref = AbsenceDB::getUserForOid($Q::person_id);
 1862         my $inr = [];
 1863         if (defined($uref)) {
 1864             $inr = (AbsenceAuthorization::divideGroups($AUTH_UID, $uref->{id}))[1];
 1865         }
 1866         dbg("modifyPerson: invisible group_ids=[".join(',', @{$inr})."]");
 1867         push(@grps, @{$inr});
 1868         dbg("modifyPerson: recombined group_ids=[".join(',', @grps)."]");
 1869     }
 1870 
 1871     # username can be passed here even if $AUTH == 0, (it will be undef)
 1872     # because it is ignored in AbsenceDB::addPerson();
 1873 
 1874     my @params = ($Q::person_id, $Q::name, $Q::username, $Q::email, \@grps);
 1875 
 1876     if ($OAP && $AUTH) {
 1877         #my $uid = AbsenceDB::findUidForObject($Q::person_id);
 1878         #dbg("pacl=[".join(',',@Q::person_acl)."]");
 1879         #dbg("gacl=[".join(',',@Q::group_acl)."]");
 1880         my ($pacl, $gacl) = convertAcl(\@Q::person_acl, \@Q::group_acl);
 1881         dbg("(converted) pacl=[".join(',',@{$pacl})."]");
 1882         dbg("(converted) gacl=[".join(',',@{$gacl})."]");
 1883         if (!checkAcls($pacl, $gacl, 'mod-person', $uid)) {
 1884             dbg("looks bad: acl violation");
 1885             reloadDisplay($q, 'Error adding person', 'Invalid person/groups');
 1886         }
 1887         recombineAcls($uid, $pacl, $gacl);
 1888         push(@params, $Q::password, $pacl, $gacl);
 1889         dumpAcl("modifyPerson: uid=$Q::username, RECOMBINED:",
 1890             {p => $pacl, g => $gacl});
 1891     }
 1892 
 1893     my @old_groups = @{$oldinfo->{group}};
 1894     my $ret = AbsenceDB::addPerson(@params);
 1895 
 1896     dbg("ret = [$ret]");
 1897 
 1898     if ($ret eq 'ok') {
 1899         dbg("looks good");
 1900         print $q->redirect($MAIN_SCRIPT);
 1901         my (@new, @old);
 1902         @old = @old_groups;
 1903         foreach my $g (@old_groups) {
 1904             if (inListN($g, \@grps)) {
 1905                 deleteElementN($g, \@old);
 1906             } else {
 1907                 push(@new, $g);
 1908             }
 1909         }
 1910         push(@new, @old);
 1911 
 1912         AbsenceImage::removeMonthImages(@new);
 1913 
 1914         exit;
 1915     } elsif ($ret eq 'duplicate-username') {
 1916         dbg("looks bad");
 1917         abslog("error modifying person_id [$Q::person_id] ret = [$ret]");
 1918         reloadDisplay($q,
 1919             "Error modifying person, username [$Q::username] already in use.",
 1920             "modify-person [$Q::name] failed.");
 1921     } else {
 1922         dbg("looks bad");
 1923         abslog("error modifying person_id [$Q::person_id] ret = [$ret]");
 1924         reloadDisplay($q,
 1925             'Error modifying person',
 1926             "modify-person [$Q::name] failed.");
 1927     }
 1928 }
 1929 
 1930 sub deleteElementN
 1931 {
 1932     my($elem, $lref) = @_;
 1933 
 1934     my $count = 0;
 1935     my $match = 0;
 1936     foreach my $tmp (@$lref) {
 1937         if ($tmp == $elem) {
 1938             $match = 1;
 1939             last;
 1940         }
 1941         $count++;
 1942     }
 1943 
 1944     if ($match) {
 1945         splice(@$lref, $count, 1);
 1946     }
 1947 }
 1948 
 1949 sub inListN
 1950 {
 1951     my ($thing, $lref) = @_;
 1952 
 1953     foreach my $elem (@{$lref}) {
 1954         ($thing == $elem) && return 1;
 1955     }
 1956 
 1957     return 0;
 1958 }
 1959 
 1960 sub modifyPersonForm
 1961 {
 1962     my $q = shift;
 1963 
 1964     my $pref = AbsenceDB::getPerson($Q::person_id);
 1965 
 1966     dbg("modifyPersonForm: person_id=[$Q::person_id]");
 1967     print $q->header(-expires => '-1d');
 1968     print $q->start_html(
 1969         -title      => "Absence: Modify $pref->{name}",
 1970         -target     => 'display',
 1971         -BGCOLOR    => $COLOR_MANAGE,
 1972     );
 1973 
 1974     if (!defined($pref)) {
 1975         reloadDisplay($q, 'Error modifying person', 'Person disappeared.');
 1976     }
 1977 
 1978     if ($AUTH) {
 1979         includeJsAclScript();
 1980     }
 1981     print $q->h1("Modify $pref->{name}");
 1982 
 1983     my @onsubmit = ($OAP && $AUTH)
 1984         ? (-onSubmit   => 'return validate(document.mod_person);') 
 1985         : ();
 1986 
 1987     print $q->start_form(
 1988         -method => 'POST',
 1989         -name   => 'mod_person',
 1990         @onsubmit,
 1991     );
 1992     print $q->hidden(-name => 'person_id', -default => $Q::person_id);
 1993     print "<TABLE>\n";
 1994 
 1995     #---------------------------------------------
 1996     # name
 1997     #---------------------------------------------
 1998     print "<TR><TH ALIGN=right>Name (Last, First)</TH><TD>\n";
 1999     print $q->textfield(
 2000         -name       => 'name',
 2001         -size       => 20,
 2002         -maxlength  => 20,
 2003         -value      => $pref->{name},
 2004     );
 2005     print "</TD><TD>[This will appear in the month-images]</TD></TR>\n";
 2006 
 2007     #---------------------------------------------
 2008     # Username
 2009     #---------------------------------------------
 2010     my $uid;
 2011     if ($AUTH && $OAP) {
 2012         $uid = AbsenceDB::findUidForObject($Q::person_id);
 2013         my ($username, $password);
 2014         if (defined($uid)) {
 2015             my $uref = AbsenceDB::getUser(id => $uid);
 2016             $username = $uref->{username};
 2017             $password = $uref->{password};
 2018         }
 2019         #------------------------
 2020         # USERNAME
 2021         #------------------------
 2022         print "<TR><TH ALIGN=right>Username</TH><TD>\n";
 2023         print $q->textfield(
 2024             -name       => 'username',
 2025             -size       => 20,
 2026             -maxlength  => 20,
 2027             -value      => $username,
 2028         );
 2029         print "</TD><TD>[This is the login-name</TD></TR>\n";
 2030         #------------------------
 2031         # PASSWORD
 2032         #------------------------
 2033         if ($MANAGE_PASSWORD) {
 2034             print "<TR><TH ALIGN=right>Password</TH><TD>\n";
 2035             print $q->textfield(
 2036                 -name       => 'password',
 2037                 -size       => 30,
 2038                 -maxlength  => 30,
 2039                 -value      => $password,
 2040             );
 2041             print "</TD><TD>[to change password, clear and enter new password]</TD></TR>\n";
 2042         }
 2043     }
 2044 
 2045     #---------------------------------------------
 2046     # E-Mail address
 2047     #---------------------------------------------
 2048     print "<TR><TH ALIGN=right>E-Mail Address</TH><TD>\n";
 2049     print $q->textfield(
 2050         -name       => 'email',
 2051         -size       => 30,
 2052         -maxlength  => 50,
 2053         -value      => exists($pref->{email}) ? $pref->{email} : '',
 2054     );
 2055     print "</TD></TR>\n";
 2056 
 2057     #---------------------------------------------
 2058     # group
 2059     #---------------------------------------------
 2060     print "<TR><TH ALIGN=right VALIGN=top>Group</TH><TD>\n";
 2061 
 2062     #abslog("calling makeGroupPopup with gid=$gid");
 2063 
 2064     my @gids = AbsenceDB::getObjectGroups($Q::person_id);
 2065     if ($GROUP_POLICY eq 'single') {
 2066         makeGroupPopup($q, $gids[0]);
 2067     } else {
 2068         makeGroupCheckboxes($q, \@gids);
 2069     }
 2070 
 2071     print "</TD><TD VALIGN=top>[select groups to which person should belong]</TD></TR>\n";
 2072 
 2073     ($AUTH && $OAP) && aclForm($q, 'mod_person', $uid);
 2074     print "</TABLE>\n";
 2075 
 2076     print $q->submit(action => 'Submit Modification');
 2077     print $q->end_form();
 2078     print $q->end_html();
 2079     exit;
 2080 }
 2081 
 2082 sub modifyGroup
 2083 {
 2084     my $q = shift;
 2085 
 2086     if (!$SUPER_USER) {
 2087         abslog("attempt to circumvent security (modifyGroup)");
 2088         reloadDisplay($q, 'Error modifying group', 'security breach thwarted');
 2089     }
 2090 
 2091     dbg("- modify group -");
 2092     if (length($Q::name) == 0) {
 2093         dbg("looks bad");
 2094         reloadDisplay($q, 'Error modifying group', 'You must supply a name.');
 2095     }
 2096     my $ret = AbsenceDB::addGroup(
 2097         $Q::group_id,
 2098         $Q::name,
 2099         $Q::pass,
 2100         $Q::description,
 2101     );
 2102     dbg("ret = [$ret]");
 2103 
 2104     if ($ret eq 'ok') {
 2105         dbg("looks good");
 2106         reloadTop($q, 'Group Successfully Modified', '_top',
 2107             'Finished. Click on button below to reload top page');
 2108         #reloadDisplay($q, 'Group Successfully Modified',
 2109         #   "new name is [$Q::name]");
 2110     } else {
 2111         dbg("looks bad");
 2112         abslog("error modifying group_id [$Q::group_id] ret = [$ret]");
 2113         reloadDisplay($q, 'Error modifying group',
 2114             "modify-group [$Q::name] failed.");
 2115     }
 2116     exit;
 2117 }
 2118 
 2119 sub modifyGroupForm
 2120 {
 2121     my $q = shift;
 2122 
 2123     my $gref = AbsenceDB::getGroup($Q::group_id);
 2124 
 2125     if (!defined($gref->{name})) {
 2126         reloadTop($q, "Modify Group $gref->{name}", 'display',
 2127             "Modify Group $gref->{name}", 'display',
 2128             'Group disappeared');
 2129     }
 2130 
 2131     print $q->header(-expires => '-1d');
 2132     print $q->start_html(
 2133         -title      => "Absence: Modify Group $gref->{name}",
 2134         -target     => 'display',
 2135         -BGCOLOR    => $COLOR_MANAGE,
 2136     );
 2137 
 2138     print $q->h1('Modify a Group');
 2139     print $q->start_form;
 2140     print $q->hidden(-name => 'group_id', -default => $Q::group_id);
 2141     print "<TABLE>\n";
 2142     print "<TR><TH ALIGN=right>Group Name</TH><TD>\n";
 2143     print $q->textfield(
 2144         -name       => 'name',
 2145         -size       => 20,
 2146         -maxlength  => 20,
 2147         -value      => $gref->{name},
 2148     );
 2149     print "</TD></TR>\n";
 2150     print "<TR><TH ALIGN=right>Description</TH><TD>\n";
 2151     print $q->textfield(
 2152         -name       => 'description',
 2153         -size       => 40,
 2154         -maxlength  => 60,
 2155         -value      => $gref->{description},
 2156     );
 2157     print "</TD></TR>\n";
 2158     print "</TD></TR></TABLE>\n";
 2159 
 2160     print $q->submit(action => 'Submit Group Modification');
 2161     print $q->end_form();
 2162     exit;
 2163 }
 2164 
 2165 sub makeGroupCheckboxes
 2166 {
 2167     my ($q, $gref) = @_;
 2168     my @gids = sort {$a <=> $b} @ADMIN_GROUPS;
 2169 
 2170     my $labref;
 2171     my $name;
 2172     foreach my $group_id (@gids) {
 2173         $name = AbsenceDB::getGroup($group_id, 'name');
 2174         $labref->{$group_id} = $name;
 2175     }
 2176 
 2177     my @sorted = sort {lc($labref->{$a}) cmp lc($labref->{$b})} @gids;
 2178 
 2179     print $q->checkbox_group(
 2180         -name       => 'group_ids',
 2181         -values     => \@sorted,
 2182         -default    => $gref,
 2183         -labels     => $labref,
 2184         -linebreak  => 'true',
 2185     );
 2186 }
 2187 
 2188 sub makeGroupPopup
 2189 {
 2190     my ($q, $default, $form, $action) = @_;
 2191 
 2192     my @addit;
 2193     if ($form) {
 2194         @addit = (-onChange => "JavaScript:document.${form}.submit('$action');"),
 2195     }
 2196 
 2197     my $labref;
 2198     foreach my $group_id (@ADMIN_GROUPS) {
 2199         $labref->{$group_id} = AbsenceDB::getGroup($group_id, 'name');
 2200     }
 2201 
 2202     my @sorted = sort {lc($labref->{$a}) cmp lc($labref->{$b})} @ADMIN_GROUPS;
 2203     print $q->popup_menu(
 2204         -name       => 'group_id',
 2205         -values     => \@sorted,
 2206         -labels     => $labref,
 2207         -default    => $default,
 2208         @addit,
 2209     );
 2210 }
 2211 
 2212 sub deletePerson
 2213 {
 2214     my $q = shift;
 2215 
 2216     # get gid first
 2217     #my $gref = AbsenceDB::getPerson($Q::person_id, 'group');
 2218     my @gids = AbsenceDB::getObjectGroups($Q::person_id);
 2219 
 2220     my $ret = AbsenceDB::deletePerson($Q::person_id);
 2221     if ($ret eq 'ok') {
 2222         print $q->redirect($MAIN_SCRIPT);
 2223         foreach my $gid (@gids) {
 2224             AbsenceImage::removeMonthImages($gid);
 2225         }
 2226     } elsif ($ret eq 'bad-id') {
 2227         reloadDisplay($q, 'Error deleting person',
 2228             'Person was deleted by someone else');
 2229     }
 2230     exit;
 2231 }
 2232 
 2233 sub reloadTop
 2234 {
 2235     my ($q, $title, $target, $msg) = @_;
 2236 
 2237     my $js = qq[
 2238         function goto_top() { top.location = '$TOP_PAGE'; }
 2239         setTimeout('goto_top()', 5000);
 2240     ];
 2241 
 2242     my @args = ($target eq '_top')
 2243         ? (-script => $js)
 2244         : ();
 2245 
 2246     print $q->header(-expires => '-1d');
 2247     print $q->start_html(
 2248         -title      => "Absence: $title",
 2249         -target     => $target,
 2250         -BGCOLOR    => $COLOR_MANAGE,
 2251         @args,
 2252     );
 2253 
 2254     print $q->h1($msg);
 2255     #print $q->start_form(
 2256     #   -action => $TOP_PAGE,
 2257     #   -method => 'GET',
 2258     #   -target => '_top',
 2259     #   #-onSubmit  => " top.location = '$TOP_PAGE';",
 2260     #);
 2261     print button(
 2262         -name       => 'reload_button',
 2263         -value      => 'Reload Calendar',
 2264         -onClick    => "parent.location.replace('$TOP_PAGE');",
 2265     );
 2266     #print $q->submit(action => 'Reload Calendar');
 2267     #print $q->end_form();
 2268     print $q->end_html();
 2269     exit 0;
 2270 }
 2271 
 2272 sub reloadDisplay
 2273 {
 2274     my ($q, $title, $msg) = @_;
 2275 
 2276     print $q->header(-expires => '-1d');
 2277     print $q->start_html(
 2278         -title      => "Absence: $title",
 2279         -target     => 'display',
 2280         -BGCOLOR    => $COLOR_MANAGE,
 2281     );
 2282 
 2283     print $q->h1($msg);
 2284     print $q->start_form(
 2285         -action => $MAIN_SCRIPT,
 2286         -method => 'GET',
 2287     );
 2288     print $q->submit(action => 'Reload Calendar');
 2289     print $q->end_form();
 2290     print $q->end_html();
 2291     exit 0;
 2292 }
 2293 
 2294 sub dbg
 2295 {
 2296     my $msg = shift;
 2297     $DEBUG || return;
 2298     abslog("DEBUG: absence-manage: $msg");
 2299 }
 2300 
 2301 sub old_dbg
 2302 {
 2303     $DEBUG || return;
 2304 
 2305     my $msg = shift;
 2306     my $fh = FileHandle->new(">>$DEBUG_OUT");
 2307     defined($fh) || die "open $DEBUG_OUT for appending";
 2308     print $fh "$msg\n";
 2309     $fh->close;
 2310 }
 2311 
 2312 sub dumpAcl
 2313 {
 2314     my ($msg, $acl) = @_;
 2315 
 2316     dbg("dumpAcl: $msg");
 2317     exists($acl->{p}) && dbg("  PERSON: "
 2318         . join('/', map "lev=$_->{level},oid=$_->{target}", @{$acl->{p}}));
 2319     exists($acl->{g}) && dbg("  GROUPS: "
 2320         . join('/', map "lev=$_->{level},gid=$_->{target}", @{$acl->{g}}));
 2321 }
 2322 
 2323 sub convertDefaultAcl
 2324 {
 2325     my $acl = shift;
 2326 
 2327     $acl || return ();
 2328 
 2329     my %level_map = (
 2330         r       => 1,
 2331         read    => 1,
 2332         w       => 2,
 2333         write   => 2,
 2334     );
 2335 
 2336     if ($acl =~ /^([wr]|write|read):(all|self)$/i) {
 2337         return { level => $level_map{$1}, target => $2 };
 2338     }
 2339 
 2340     die "unable to parse default-acl [$acl]";
 2341 }
 2342 
 2343 sub aclForm
 2344 {
 2345     my ($q, $form, $uid) = @_;
 2346 
 2347     $DEBUG && abslog("aclForm: form=[$form], uid=[$uid]");
 2348     my $js_target = 'document.'.$form;
 2349 
 2350     my $thing = ($form =~/_person$/) ? 'person' : 'user';
 2351     my $verb = ($form =~/add/) ? 'adding' : 'modifying';
 2352 
 2353     my ($pdref, $gdref);
 2354 
 2355     $pdref = {};
 2356     $gdref = {};
 2357 
 2358     my ($lev, $person, $gid);
 2359 
 2360     my @levmap = (
 2361         undef,
 2362         'Read',
 2363         'Write',
 2364         undef,
 2365         'Admin',
 2366     );
 2367 
 2368     if ($form ne 'add_user') {
 2369         my (@pdefs, @gdefs);
 2370 
 2371         if ($uid) {
 2372             my $acl = AbsenceAuthorization::getAdminAcls($AUTH_UID, $uid);
 2373             #if ($DEBUG) {
 2374             #   my $realacl = AbsenceDB::getAcl($uid);
 2375             #   dumpAcl("aclForm: form=$form, uid=$uid, REAL:", $realacl);
 2376             #   dumpAcl("aclForm: form=$form, uid=$uid, PRUNED:", $acl);
 2377             #}
 2378             @pdefs = @{ $acl->{object} };
 2379             @gdefs = @{ $acl->{group} };
 2380             $DEBUG && abslog("dump of \@gdefs:\n".Dumper(\@gdefs)."\n--done--");
 2381         } else {
 2382             my $tmp = AbsenceConfig::fetch('pacl_default');
 2383             @pdefs = (convertDefaultAcl($tmp));
 2384             $tmp = AbsenceConfig::fetch('gacl_default');
 2385             @gdefs = (convertDefaultAcl($tmp));
 2386         }
 2387 
 2388         foreach my $acl (@pdefs) {
 2389             ($acl->{level} == 2) || die "nonsense pacl level [$acl->{level}]";
 2390             if ($acl->{target} eq 'self') {
 2391                 $pdref->{'2:self'} = 'Write:self';
 2392             } elsif ($acl->{target} =~ /^(\d+)$/) {
 2393                 my $name = AbsenceDB::getPerson($acl->{target}, 'name');
 2394                 $pdref->{"2:$acl->{target}"} = "Write:$name";
 2395             } else {
 2396                 die "strange person rule: [$acl->{level}:$acl->{target}]";
 2397             }
 2398         }
 2399 
 2400         foreach my $acl (@gdefs) {
 2401             if ($acl->{target} =~ /^(all|self)$/) {
 2402                 $gdref->{"$acl->{level}:$acl->{target}"}
 2403                     = "$levmap[$acl->{level}]:$acl->{target}";
 2404             } elsif ($acl->{target} =~ /^(\d+)$/) {
 2405                 my $name = AbsenceDB::getGroup($acl->{target}, 'name');
 2406                 $gdref->{"$acl->{level}:$acl->{target}"}
 2407                     = "$levmap[$acl->{level}]:$name";
 2408             } else {
 2409                 die "strange group rule: [$acl->{level}:$acl->{target}]";
 2410             }
 2411         }
 2412     }
 2413 
 2414     print qq[<TR><TD></TD><TD COLSPAN=99>\n];
 2415     javaScriptWarning();
 2416     print qq[</TH></TR>\n];
 2417 
 2418     ######################### GROUP START #########################
 2419     #------------------------------------------------------------
 2420     # GROUP stuff
 2421     #------------------------------------------------------------
 2422     print qq[<TR><TH ALIGN=right VALIGN=top>Group ACL<BR>Management</TH>
 2423         <TD COLSPAN=2>\n];
 2424 
 2425     # TABLE wrapper
 2426     print qq[<TABLE BORDER=1><TR><TD>\n];
 2427 
 2428     print qq[<TABLE>\n];
 2429 
 2430     #-------------------------------------------
 2431     # instructions
 2432     #-------------------------------------------
 2433     if ($thing eq 'person') {
 2434         print qq[<TR><TH COLSPAN=99 ALIGN=left><SMALL>
 2435             Use Group ACLs to control what
 2436             the person you are $verb can do with her own group or other
 2437             groups.  Choose a permission (read/write/admin), choose a
 2438             target group for that permission to act upon, then click on
 2439             "Add" to add the 'rule' to the list on the right.  The group
 2440             "self" refers to all groups to which the person belongs.<BR>
 2441             Permissions: read: view group, write: add/change/delete
 2442             absences, admin: add/change/delete people.
 2443             <BR><HR>
 2444             </SMALL></TH></TR>\n];
 2445     } else {
 2446         print qq[<TR><TH COLSPAN=99 ALIGN=left><SMALL>
 2447             Use Group ACLs to control what
 2448             the user you are $verb can do with
 2449             groups.  Choose a permission (read/write/admin), choose a
 2450             target group for that permission to act upon, then click on
 2451             "Add" to add the 'rule' to the list on the right.
 2452             <BR>
 2453             Permissions: read: view group, write: add/change/delete
 2454             absences, admin: add/change/delete people.
 2455             <BR><HR>
 2456             </SMALL></TH></TR>\n];
 2457     }
 2458 
 2459     print qq[<TR>
 2460         <TD VALIGN=top WIDTH="100">
 2461         Permission:<BR>\n];
 2462 
 2463     my @perms = qw(read write admin);
 2464     my $lref = {
 2465         1   => 'Read',
 2466         2   => 'Write',
 2467         4   => 'Admin',
 2468     };
 2469 
 2470     print $q->radio_group(
 2471             -name       => 'groupverb',
 2472             -values     => [1, 2, 4],
 2473             -linebreak  => 'true',
 2474             -labels     => $lref,
 2475         ),
 2476         qq[</TD>
 2477         <TD VALIGN=top WIDTH="150">
 2478         Group:<BR>\n];
 2479 
 2480     $lref = undef;
 2481     foreach my $gid (@ADMIN_GROUPS) {
 2482         $lref->{$gid} = AbsenceDB::getGroup($gid, 'name');
 2483     }
 2484     $lref->{self} = 'self';
 2485     $lref->{all} = 'all';
 2486     @list = ();
 2487     if (($form eq 'add_person') ||
 2488         (($form eq 'mod_person') &&
 2489          (AbsenceAuthorization::selfAllowed($AUTH_UID, $uid))))
 2490     {
 2491         @list = ('self');
 2492     }
 2493     AbsenceAuthorization::adminAll($AUTH_UID) && push(@list, 'all');
 2494     push(@list, sort {lc($lref->{$a}) cmp lc($lref->{$b})} @ADMIN_GROUPS);
 2495     print $q->popup_menu(
 2496         -name       => 'grouplist',
 2497         -values     => \@list,
 2498         -labels     => $lref,
 2499         -size       => 5,
 2500         -multiple   => undef,
 2501     );
 2502     print qq[</TD>
 2503         <TD WIDTH="100">\n],
 2504         $q->button(
 2505             -name   => 'add_group',
 2506             -value  => 'Add',
 2507             -onClick    => "add('group', $js_target)",
 2508         ), "<BR>\n",
 2509         $q->button(
 2510             -name   => 'del_group',
 2511             -value  => 'Delete',
 2512             -onClick    => "del('group', $js_target)",
 2513         ),
 2514         qq[</TD>
 2515         <TD WIDTH="150">\nSelected Rules:<BR>\n],
 2516         $q->popup_menu(
 2517             -name       => 'group_acl',
 2518             -values     => [keys(%{$gdref})],
 2519             -labels     => $gdref,
 2520             -size       => 5,
 2521             -multiple   => undef,
 2522         ),
 2523         qq[</TD>\n</TR>\n];
 2524 
 2525     # HR
 2526     #print qq[<TR><TD COLSPAN=4><HR></TD></TR>\n];
 2527 
 2528     print qq[</TABLE>\n];
 2529 
 2530     # TABLE wrapper
 2531     print qq[</TD></TR></TABLE>\n];
 2532     ######################### GROUP END #########################
 2533 
 2534     print qq[</TD></TR>\n];
 2535 
 2536     ######################### PERSON START #########################
 2537     #------------------------------------------------------------
 2538     # PERSON stuff
 2539     #------------------------------------------------------------
 2540     print qq[<TR><TH ALIGN=right VALIGN=top>Person ACL<BR>Management</TH>
 2541         <TD COLSPAN=2>\n];
 2542 
 2543     # TABLE wrapper
 2544     print qq[<TABLE BORDER=1><TR><TD>\n];
 2545 
 2546     print qq[<TABLE>\n];
 2547 
 2548     #-------------------------------------------
 2549     # instructions
 2550     #-------------------------------------------
 2551     if ($thing eq 'person') {
 2552         print qq[<TR><TH COLSPAN=99 ALIGN=left><SMALL>
 2553             Use Person ACLs to control what
 2554             the person you are $verb can do with herself or other
 2555             people in groups which are visible to her (see above).
 2556             The only permission available is "write". Choose a
 2557             target person for whom "write" access is to be allowed,
 2558             then click "Add" to add the 'rule' to the list on the right.
 2559             The special person "self" refers to the person you are $verb.
 2560             <BR>
 2561             "write" access means adding, modifying, and deleting absences
 2562             is allowed.
 2563             <BR><HR>
 2564             </SMALL></TH></TR>\n];
 2565     } else {
 2566         print qq[<TR><TH COLSPAN=99 ALIGN=left><SMALL>
 2567             Use Person ACLs to control what
 2568             the user you are $verb can do with
 2569             people in groups which are visible to her (see above).
 2570             The only permission available is "write". Choose a
 2571             target person for whom "write" access is to be allowed,
 2572             then click "Add" to add the 'rule' to the list on the right.
 2573             The special person "self" refers to the person you are $verb.
 2574             <BR>
 2575             "write" access means adding, modifying, and deleting absences
 2576             is allowed.
 2577             <BR><HR>
 2578             </SMALL></TH></TR>\n];
 2579     }
 2580 
 2581     print qq[<TR>
 2582         <TD VALIGN=top WIDTH="100">
 2583         Permission:<BR>
 2584         <INPUT TYPE=radio NAME="personverb" VALUE="write" CHECKED>Write
 2585         </TD>
 2586         <TD VALIGN=top WIDTH="150">
 2587         Person:<BR>\n];
 2588 
 2589     $lref = {};
 2590     my @people = AbsenceAuthorization::getAdminPeople($AUTH_UID);
 2591     foreach my $pid (@people) {
 2592         $lref->{$pid} = AbsenceDB::getPerson($pid, 'name');
 2593     }
 2594     $lref->{self} = 'self';
 2595     my @list = ($form =~ /_person$/) ?  ('self') : ();
 2596     push(@list, sort {lc($lref->{$a}) cmp lc($lref->{$b})} @people);
 2597 
 2598     print $q->popup_menu(
 2599         -name       => 'personlist',
 2600         -values     => \@list,
 2601         -labels     => $lref,
 2602         -size       => 5,
 2603         -multiple   => undef,
 2604     );
 2605         
 2606     print qq[</TD>\n
 2607         <TD WIDTH="100">\n],
 2608         $q->button(
 2609             -name   => 'add_person',
 2610             -value  => 'Add',
 2611             -onClick    => "add('person', $js_target)",
 2612         ),
 2613         "<BR>\n",
 2614         $q->button(
 2615             -name   => 'del_person',
 2616             -value  => 'Delete',
 2617             -onClick    => "del('person', $js_target)",
 2618         ),
 2619         qq[</TD>
 2620         <TD WIDTH="150">\nSelected Rules:<BR>],
 2621         $q->popup_menu(
 2622             -name       => 'person_acl',
 2623             -values     => [keys(%{$pdref})],
 2624             -labels     => $pdref,
 2625             -size       => 5,
 2626             -multiple   => undef,
 2627         ),
 2628         qq[</TD></TR>\n];
 2629         #print qq[<TR><TD COLSPAN=4 ALIGN="center">\n];
 2630         #print qq[<SMALL>NOTE: you cannot add "write" permission for a
 2631         #   person in a group for which the user does not have
 2632         #   "read" permission.</SMALL>\n];
 2633         #print qq[</TD></TR>\n];
 2634 
 2635         print qq[<TR>\n</TABLE>\n];
 2636 
 2637     # TABLE wrapper
 2638     print qq[</TD></TR></TABLE>\n];
 2639     ######################### PERSON END #########################
 2640 
 2641     print qq[</TD></TR>\n];
 2642 }
 2643 
 2644 sub includeJsAclScript
 2645 {
 2646     my $path = AbsenceConfig::fetch('js_acl_script');
 2647     #my $path = "$base/acl.js";
 2648     #print qq[<SCRIPT LANGUAGE="JavaScript" SRC="$path"></SCRIPT>\n];
 2649     print qq{<script src="$path" type="text/javascript"></script>\n};
 2650 }
 2651 
 2652 sub includeJsRtCoincidenceScript
 2653 {
 2654     my $base = AbsenceConfig::fetch('js_dir_rel');
 2655     my $path = "$base/rt_coincidence.js";
 2656     #print qq[<SCRIPT LANGUAGE="JavaScript" SRC="$path"></SCRIPT>\n];
 2657     print qq{<script src="$path" type="text/javascript"></script>\n};
 2658 }
 2659 
 2660 sub includeJsAclScript_old
 2661 {
 2662     my $path = AbsenceConfig::fetch('js_acl_script');
 2663 
 2664     #print qq[<SCRIPT LANGUAGE="JavaScript" SRC="$path"></SCRIPT>\n];
 2665     my $fh = FileHandle->new($path) || die "open [$path] to read";
 2666     print qq[<SCRIPT LANGUAGE="JavaScript">\n<!--\n];
 2667     while(<$fh>) {
 2668         print $_;
 2669     }
 2670     $fh->close;
 2671     print "-->\n</SCRIPT>\n";
 2672 }
 2673 
 2674 sub javaScriptWarning
 2675 {
 2676     print <<_EOF_;
 2677 <NOSCRIPT>
 2678 <FONT SIZE=4 COLOR="red">
 2679 You will not be able to manage ACLs because your browser<BR>
 2680 does not support JavaScript or you have not enabled it.
 2681 </FONT>
 2682 </NOSCRIPT>
 2683 _EOF_
 2684 }
 2685 
 2686 __END__
 2687 
 2688 =head1 NAME
 2689 
 2690 absence-manage.pl - manage people and groups
 2691 
 2692 =head1 DESCRIPTION
 2693 
 2694 C<absence-manage.pl> is responsible for displaying some forms for
 2695 the management of people and groups, and handling the processing
 2696 after the user clicks on submit in one of the forms.
 2697 
 2698 =cut