"Fossies" - the Fresh Open Source Software Archive

Member "absence-v2.1/cgi-bin/absence-manage.pl" (15 Dec 2013, 70709 Bytes) of package /linux/www/web-absence-2.1.tar.gz:


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

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