"Fossies" - the Fresh Open Source Software Archive

Member "absence-v2.1/install.pl" (20 Oct 2013, 42963 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 "install.pl" see the Fossies "Dox" file reference documentation.

    1 #!/usr/bin/perl
    2 
    3 #-------------------------------------------------------------------------
    4 # install.pl
    5 #
    6 # If you already have a previous version of absence installed, you
    7 # can use install.pl to update your configuration.  It will not
    8 # overwrite the datafiles (database-file, hoiday-db, absence-types-db,
    9 # log-file).
   10 #
   11 # This script is a nightmare.  I know.  It seems to work, though.
   12 # @copyright Robert Urban
   13 #-------------------------------------------------------------------------
   14 
   15 #======================================================================
   16 #    This file is part of Absence.
   17 #
   18 #    Absence is free software: you can redistribute it and/or modify
   19 #    it under the terms of the GNU General Public License as published by
   20 #    the Free Software Foundation, either version 3 of the License, or
   21 #    (at your option) any later version.
   22 #
   23 #    Absence is distributed in the hope that it will be useful,
   24 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
   25 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   26 #    GNU General Public License for more details.
   27 #
   28 #    You should have received a copy of the GNU General Public License
   29 #    along with Absence.  If not, see <http://www.gnu.org/licenses/>.
   30 #======================================================================
   31 
   32 use FileHandle;
   33 use File::Basename;
   34 use Config;
   35 
   36 # load these now to make sure they are available for absence system
   37 my @mod_dependencies = qw(GD Digest::MD5 DBI CGI CGI::Session DBD::Pg);
   38 my $prereq_not_found = 0;
   39 foreach my $mod (@mod_dependencies) {
   40     eval "require $mod;";
   41     if ($@) {
   42         print qq[prerequisite module "$mod" is not available/installed.\n];
   43         $prereq_not_found = 1;
   44     }
   45 }
   46 
   47 if ($prereq_not_found) {
   48     die "cannot continue. prerequisites missing.\n";
   49 }
   50 
   51 use lib qw{./utils};
   52 use AbsenceInstall;
   53 use AbsenceImport;
   54 use AbsenceMigration;
   55 use AbsenceUtils qw(query yesNo);
   56 
   57 use strict;
   58 
   59 my %VALUES;
   60 my $CMDOUT;
   61 
   62 # structure to hold information about parameters
   63 my %PARMS = (
   64     data_dir_rel    => {
   65         short   => 'ddr',
   66         class   => 'path',
   67         desc    => 'relative path to data',
   68     },
   69     data_dir_abs    => {
   70         short   => 'dda',
   71         class   => 'path',
   72         desc    => 'absolute path to data',
   73         def     => [
   74             '$DOCUMENT_ROOT',
   75             'data_dir_rel'
   76         ],
   77     },
   78     cgi_dir_rel     => {
   79         short   => 'cdr',
   80         class   => 'path',
   81         desc    => 'relative path to cgi-bin',
   82         def     => '/cgi-bin',
   83     },
   84     cgi_dir_abs     => {
   85         short   => 'cda',
   86         class   => 'path',
   87         desc    => 'absolute path to cgi-bin',
   88         def     => [
   89             '$DOCUMENT_ROOT',
   90             '..',
   91             'cgi_dir_rel'
   92         ],
   93     },
   94     image_dir_rel   => {
   95         short   => 'idr',
   96         class   => 'path',
   97         desc    => 'relative path to image-dir',
   98         def     => [
   99             'data_dir_rel',
  100             'img',
  101         ],
  102     },
  103     js_dir_rel  => {
  104         short   => 'jdr',
  105         class   => 'path',
  106         desc    => 'relative path to JavaScript-dir',
  107         def     => [
  108             'data_dir_rel',
  109             'JavaScript',
  110         ],
  111     },
  112     js_dir_abs  => {
  113         short   => 'jda',
  114         class   => 'path',
  115         desc    => 'absolute path to JavaScript-dir',
  116         def     => [
  117             'data_dir_abs',
  118             'JavaScript'
  119         ],
  120     },
  121     image_dir_abs   => {
  122         short   => 'ida',
  123         class   => 'path',
  124         desc    => 'absolute path to image-dir',
  125         def     => [
  126             'data_dir_abs',
  127             'img',
  128         ],
  129     },
  130     util_dir_abs    => {
  131         short   => 'uda',
  132         class   => 'path',
  133         desc    => 'absolute path to util-dir',
  134         def     => [
  135             'data_dir_abs',
  136             'Utils',
  137         ],
  138     },
  139     log_file        => {
  140         short   => 'lf',
  141         class   => 'file',
  142         perm    => 0660,
  143         desc    => 'absolute path to log-file',
  144         name    => 'log',
  145         def     => [
  146             'data_dir_abs',
  147             'name',
  148         ],
  149     },
  150     main_script     => {
  151         short   => 'ms',
  152         class   => 'script',
  153         desc    => 'relative path to main-script',
  154         name    => 'absence.pl',
  155         def     => [
  156             'cgi_dir_rel',
  157             'name',
  158         ],
  159     },
  160     manage_script   => {
  161         short   => 'mgs',
  162         class   => 'script',
  163         desc    => 'relative path to manage-script',
  164         name    => 'absence-manage.pl',
  165         def     => [
  166             'cgi_dir_rel',
  167             'name',
  168         ],
  169     },
  170     control_script  => {
  171         short   => 'cs',
  172         class   => 'script',
  173         desc    => 'relative path to control-script',
  174         name    => 'absence-control.pl',
  175         def     => [
  176             'cgi_dir_rel',
  177             'name',
  178         ],
  179     },
  180     top_page        => {
  181         short   => 'tp',
  182         class   => 'path',
  183         desc    => 'relative path to starting-page',
  184         def     => 'data_dir_rel',
  185     },
  186     legend_style    => {
  187         short   => 'ls',
  188         class   => 'param',
  189         desc    => '"fit" or "constant:XX"',
  190         def     => 'fit',
  191         allow   => '(fit|constant:\d+)',
  192     },
  193     image_type      => {
  194         short   => 'it',
  195         class   => 'param',
  196         desc    => '"png", "jpg", or "gif"',
  197         def     => 'png',
  198         allow   => ['png', 'jpg', 'gif'],
  199     },
  200     map_type        => {
  201         short   => 'mt',
  202         class   => 'param',
  203         desc    => "map-type (client or server)",
  204         def     => 'client',
  205         allow   => ['client', 'server'],
  206         extra   => 'type "server" is not well tested',
  207     },
  208     cookie_domain   => {
  209         short   => 'cd',
  210         class   => 'param-disuse',
  211         desc    => 'domain to use for cookies',
  212     },
  213     holiday_label   => {
  214         short   => 'hl',
  215         class   => 'param',
  216         desc    => 'label to use for holidays',
  217         def     => 'Holiday',
  218     },
  219     holiday_scheme  => {
  220         short   => 'hsch',
  221         class   => 'param',
  222         desc    => 'holiday scheme',
  223         extra   => 'advanced: country/region-based holidays, basic: unified holidays',
  224         def     => 'basic',
  225         allow   => [ 'advanced', 'basic' ],
  226     },
  227     holiday_mark    => {
  228         short   => 'hmrk',
  229         class   => 'param-holiday-basic',
  230         desc    => 'holiday indicator',
  231         extra   => 'small: show only in header, large: in entire column',
  232         def     => 'small',
  233         allow   => [ 'small', 'large' ],
  234     },
  235     show_holidays_in_header => {
  236         short   => 'shih',
  237         class   => 'param-holiday-advanced',
  238         desc    => 'show regional/country holidays in header',
  239         def     => 'yes',
  240         allow   => [ 'yes', 'no' ],
  241     },
  242     header_holiday_country  => {
  243         short   => 'hhc',
  244         class   => 'param-holiday-advanced',
  245         desc    => 'show holidays from this country in header',
  246         def     => undef,
  247     },
  248     header_holiday_region   => {
  249         short   => 'hhr',
  250         class   => 'param-holiday-advanced',
  251         desc    => 'show holidays from this region in header',
  252         def     => undef,
  253     },
  254     skip_we_hol => {
  255         short   => 'swh',
  256         class   => 'param',
  257         desc    => 'do not display reservations for sat/sun/holidays',
  258         def     => 'no',
  259         allow   => [ 'yes', 'no' ],
  260     },
  261     skip_mark_skipped   => {
  262         short   => 'sms',
  263         class   => 'param-skip',
  264         desc    => 'draw empty blocks for skipped days',
  265         def     => 'no',
  266         allow   => [ 'yes', 'no' ],
  267     },
  268     group_policy    => {
  269         short   => 'gp',
  270         class   => 'param',
  271         desc    => 'group-policy',
  272         def     => 'single',
  273         allow   => ['single', 'multiple'],
  274     },
  275     authentication  => {
  276         short   => 'auth',
  277         class   => 'param',
  278         desc    => 'Use authentication',
  279         def     => 'no',
  280         allow   => ['yes', 'no'],
  281     },
  282     auth_type   => {
  283         short   => 'at',
  284         class   => 'param-auth',
  285         desc    => 'authentication type ("http" or "simple")',
  286         def     => 'simple',
  287         allow   => ['http', 'simple'],
  288     },
  289     secret  => {
  290         short   => 'sec',
  291         class   => 'param-auth-simple',
  292         desc    => 'a short secret string for hashing',
  293         def     => undef,
  294     },
  295     credential_src  => {
  296         short   => 'crs',
  297         class   => 'param-auth',
  298         desc    => 'source for credentials',
  299         def     => 'absence',
  300         allow   => ['absence', 'htaccess'],
  301     },
  302     session_timeout => {
  303         short   => 'st',
  304         class   => 'param-auth-simple',
  305         desc    => 'session timeout',
  306         extra   => 'values: 0 = none, 1m = 1 minute, 1d = 1 day, etc',
  307         def     => 0,
  308         allow   => '\d+[smhdwM]',
  309     },
  310     manage_password => {
  311         short   => 'mp',
  312         class   => 'param-auth',
  313         desc    => 'absence manages passwords',
  314         def     => 'yes',
  315         allow   => ['yes', 'no'],
  316     },
  317     pw_hash_format  => {
  318         short   => 'phf',
  319         class   => 'param-auth-simple',
  320         desc    => 'how to store managed passwords',
  321         def     => 'md5',
  322         allow   => ['md5', 'cleartext'],
  323     },
  324     htaccess_path   => {
  325         short   => 'htp',
  326         class   => 'param-auth-http',
  327         desc    => 'absolute path to ".htaccess" file',
  328         def     => undef,
  329     },
  330     auth_realm  => {
  331         short   => 'ar',
  332         class   => 'param-auth-http',
  333         desc    => 'realm name for http authentication',
  334         def     => 'Absence',
  335     },
  336     pacl_default    => {
  337         short   => 'pacl',
  338         class   => 'param-auth',
  339         desc    => 'default person ACL',
  340         def     => 'undef',
  341         allow   => '(w:self)?',
  342         undef   => 1,
  343     },
  344     gacl_default    => {
  345         short   => 'gacl',
  346         class   => 'param-auth',
  347         desc    => 'default group ACL',
  348         def     => 'w:self',
  349         allow   => '([wr]:(self|all)+)?',
  350         undef   => 1,
  351     },
  352     objects_are_people  => {
  353         short   => 'oap',
  354         class   => 'param-auth',
  355         desc    => 'are managed objects people',
  356         def     => undef,
  357         allow   => ['yes', 'no'],
  358     },
  359     nph_lo_script   => {
  360         short   => 'nls',
  361         class   => 'script',
  362         desc    => 'path to logout script',
  363         name    => 'nph-absence-logout.pl',
  364         def     => [
  365             'cgi_dir_rel',
  366             'name',
  367         ],
  368     },
  369     js_acl_script   => {
  370         short   => 'acla',
  371         class   => 'script',
  372         desc    => 'absolute path to JS ACL source',
  373         name    => 'acl.js',
  374         def     => [
  375             'js_dir_rel',
  376             'name',
  377         ],
  378     },
  379     multi_res   => {
  380         short   => 'mr',
  381         class   => 'param',
  382         desc    => 'allow multiple reservations on same day',
  383         def     => undef,
  384         allow   => [ 'yes', 'no' ],
  385     },
  386     max_multi   => {
  387         short   => 'mmr',
  388         class   => 'param-multi',
  389         desc    => 'max num multi reservations',
  390         def     => 2,
  391         allow   => '\d+',
  392     },
  393     variable_height => {
  394         short   => 'mrvh',
  395         class   => 'param-multi',
  396         desc    => 'allow height of person-row to vary',
  397         def     => undef,
  398         allow   => [ 'yes', 'no' ],
  399     },
  400     min_height  => {
  401         short   => 'mrmh',
  402         class   => 'param-multi',
  403         desc    => 'min height (in full reservations) for person-rows',
  404         def     => 1,
  405         allow   => '\d+',
  406     },
  407     alternate_colors    => {
  408         short   => 'altc',
  409         class   => 'param',
  410         desc    => 'alternate person-row bg colors',
  411         def     => 'no',
  412         allow   => [ 'yes', 'no' ],
  413     },
  414     vertical_grid   => {
  415         short   => 'vtg',
  416         class   => 'param',
  417         desc    => 'draw vertical grid lines',
  418         def     => 'yes',
  419         allow   => [ 'yes', 'no' ],
  420     },
  421     database_name   => {
  422         short   => 'dbn',
  423         class   => 'param-db',
  424         desc    => 'the database name',
  425         def     => 'absence',
  426     },
  427     database_host   => {
  428         short   => 'dbh',
  429         class   => 'param-db',
  430         desc    => 'the database host',
  431         def     => 'localhost',
  432     },
  433     database_port   => {
  434         short   => 'dbpt',
  435         class   => 'param-db',
  436         desc    => 'the database port number',
  437         def     => undef,
  438         none    => 1,
  439     },
  440     database_user   => {
  441         short   => 'dbu',
  442         class   => 'param-db',
  443         desc    => 'the database username',
  444         def     => 'absence',
  445     },
  446     database_pass   => {
  447         short   => 'dbp',
  448         class   => 'param-db',
  449         desc    => 'the database password',
  450         def     => 'absence',
  451     },
  452     database_adm_user   => {
  453         short   => 'dbau',
  454         class   => 'param-db',
  455         desc    => 'the database admin username',
  456         def     => 'postgres',
  457     },
  458     database_adm_pass   => {
  459         short   => 'dbap',
  460         class   => 'param-db',
  461         desc    => 'the database admin password',
  462         def     => 'undef',
  463         none    => 1,
  464         undef   => 1,
  465         extra   => qq{use "undef" to indicate that no password is necessary,\nwhich may allow an admin connection to the server\nwithout providing a password},
  466     },
  467     migrate_data => {
  468         short   => 'mig',
  469         class   => 'install',
  470         desc    => 'migrate existing v1.X data',
  471         def     => 'no',
  472         allow   => [ 'yes', 'no' ],
  473     },
  474 );
  475 
  476 my @PATHS = qw(
  477     cgi_dir_rel
  478     cgi_dir_abs
  479     data_dir_rel
  480     data_dir_abs
  481     image_dir_rel
  482     image_dir_abs
  483     js_dir_rel
  484     js_dir_abs
  485     top_page
  486 );
  487 
  488 my @cgi = qw(
  489     absence.pl
  490     absence-click.pl
  491     absence-control.pl
  492     absence-manage.pl
  493     nph-absence-logout.pl
  494     AbsenceConfig.pm
  495     AbsenceDate.pm
  496     AbsenceDB.pm
  497     AbsenceImage.pm
  498     AbsenceInput.pm
  499     AbsenceLog.pm
  500     AbsenceAuthentication.pm
  501     AbsenceAuthorization.pm
  502 );
  503 
  504 my @js = qw(
  505     acl.js
  506     rt_coincidence.js
  507 );
  508 
  509 my @misc = qw(
  510     INSTALL.txt
  511     README-AUTH.txt
  512     README-CONFIGURATION.txt
  513     README-INSTANCES.txt
  514     README.txt
  515 );
  516 
  517 my @html = qw(
  518     absence-help.html
  519 );
  520 
  521 #demo.html
  522 
  523 my $VERBOSE = 1;
  524 my $DEBUG = 0;
  525 
  526 my %VALS;
  527 
  528 #----------------------------------------------------------------------
  529 # main
  530 #----------------------------------------------------------------------
  531 
  532 umask(0);
  533 
  534 # generate short-name to long-name param map
  535 my ($long, $desc);
  536 my $force = 0;
  537 
  538 my $WINDOZE = 0;
  539 if ($Config{osname} eq 'MSWin32') {
  540     # blech, gasp, spit, hack, cough, wheeze, grunt, scream
  541     $WINDOZE = 1;
  542 }
  543 
  544 if (!$WINDOZE && ($> == 0)) {
  545     print "$0 should not be run as root.\n";
  546     print "please re-run as a normal user.\n\n";
  547     if (!yesNo("Are you SURE you want to continue", 0)) {
  548         print "bailing!\n";
  549         exit;
  550     }
  551 }
  552 
  553 #--------------------------------------------------------------------
  554 # create hash to look up nicknames
  555 #--------------------------------------------------------------------
  556 my %SHORTMAP;
  557 foreach (keys(%PARMS)) {
  558     $SHORTMAP{ $PARMS{$_}->{short} } = $_;
  559 }
  560 
  561 #--------------------------------------------------------------------
  562 # parse script parameters
  563 #--------------------------------------------------------------------
  564 while($_ = shift) {
  565     s/^-//;
  566     if (exists($SHORTMAP{$_})) {
  567         $_ = $SHORTMAP{$_};
  568     }
  569     if (/^h$/) {
  570         usage();
  571         exit;
  572     } elsif (/^d$/) {
  573         print "setting DEBUG mode.\n";
  574         $DEBUG++;
  575     } elsif (/^f/) {
  576         $force = 1;
  577     } elsif (/^(dr|docroot)/) {
  578         $ENV{DOCUMENT_ROOT} = shift;
  579     } elsif (exists($PARMS{$_})) {
  580         my $val = shift;
  581         my $tmp = ($val =~ /^def(ault)?$/) ? default($_) : $val;
  582         print "setting $_ to [$tmp]\n";
  583         #$tmp = undef if ($tmp eq 'undef');
  584         $VALUES{$_} = $tmp;
  585     } elsif (exists($SHORTMAP{$_})) {
  586         my $val = shift;
  587         my $tmp = ($val =~ /^def(ault)?$/) ? default($_) : $val;
  588         print "setting $_ to [$tmp]\n";
  589         #$tmp = undef if ($tmp eq 'undef');
  590         $VALUES{$SHORTMAP{$_}} = $tmp;
  591     }
  592 }
  593 
  594 print <<_EOF_;
  595 
  596 Starting installation of absence V2.0...
  597 
  598 I may need to ask you some configuration details.
  599 
  600 The descriptions of the parameters refer to "absolute" and "relative"
  601 paths.  By "absolute", I mean a normal (filesystem) path as seen by a
  602 script, for example "/users/apache/html".  By "relative", I mean the
  603 path component of a URL, i.e., relative to DOCUMENT_ROOT.
  604 For example, given the URL
  605 
  606     http://www.unix-wissen.de/apps/absence
  607 
  608 The "relative path" in this case is "/apps/absence".
  609 
  610 _EOF_
  611 
  612 #--------------------------------------------------------------------
  613 # ask general questions
  614 #--------------------------------------------------------------------
  615 my $use_dr = 0;
  616 #foreach my $p (@PATHS, getClassKeys('param')) {
  617 foreach my $p (getClassKeys('path', 'param')) {
  618     checkParam($p);
  619     if ($VALS{$p} =~ /\$DOCUMENT_ROOT/) {
  620         $use_dr = 1;
  621         if ($WINDOZE) {
  622             print "WARNING: Windoze/IIS does not support DOCUMENT_ROOT\n";
  623         }
  624     }
  625 }
  626 
  627 #--------------------------------------------------------------------
  628 # ask database questions
  629 #--------------------------------------------------------------------
  630 print "\nNow I must get information about database.\n\n";
  631 #$VALUES{db_admin_user} = query('What is the username of the DB administrator');
  632 #$VALUES{db_admin_pass} = query('What is the password for the DB administrator');
  633 foreach my $p (getClassKeys('param-db')) {
  634     checkParam($p);
  635 }
  636 
  637 my @db_params = (
  638     user    => $VALUES{database_adm_user},
  639     pass    => $VALUES{database_adm_pass},
  640 );
  641 
  642 if (defined($VALUES{database_host}) && ($VALUES{database_host} ne 'localhost'))
  643 {
  644     push(@db_params, host => $VALUES{database_host});
  645 }
  646 
  647 if (!AbsenceInstall::testConnection(@db_params)) {
  648     die "connection to database as $VALUES{database_adm_user} failed\n";
  649 }
  650 print "successfully connected to database as user [$VALUES{database_adm_user}]\n";
  651 
  652 #--------------------------------------------------------------------
  653 # ask authentication/authorization questions
  654 #--------------------------------------------------------------------
  655 if ($VALUES{authentication} eq 'yes') {
  656     print "\nNow I must ask you some questions about authentication.\n\n";
  657     checkParam('auth_type');
  658     my $type = $VALUES{auth_type};
  659 
  660     foreach my $p (getClassKeys('param-auth', "param-auth-$type")) {
  661         checkParam($p);
  662     }
  663 }
  664 
  665 #--------------------------------------------------------------------
  666 # ask multi-res questions
  667 #--------------------------------------------------------------------
  668 if ($VALUES{multi_res} eq 'yes') {
  669     print "\nNow I must ask some questions about multiple reservations.\n\n";
  670 
  671     foreach my $p (getClassKeys('param-multi')) {
  672         checkParam($p);
  673     }
  674 }
  675 
  676 #--------------------------------------------------------------------
  677 # ask holiday questions
  678 #--------------------------------------------------------------------
  679 print "\nNow I must ask some questions about holidays.\n\n";
  680 my $scheme = $VALUES{holiday_scheme};
  681 
  682 foreach my $p (getClassKeys("param-skip-$scheme")) {
  683     checkParam($p);
  684 }
  685 
  686 #--------------------------------------------------------------------
  687 # ask skip questions
  688 #--------------------------------------------------------------------
  689 if ($VALUES{skip_we_hol} eq 'yes') {
  690     print "\nNow I must ask some questions about skipping weekends/holidays.\n\n";
  691 
  692     foreach my $p (getClassKeys('param-skip')) {
  693         checkParam($p);
  694     }
  695 }
  696 
  697 #--------------------------------------------------------------------
  698 # ask install questions
  699 #--------------------------------------------------------------------
  700 print "\nNow I must ask some questions about the installation.\n\n";
  701 
  702 foreach my $p (getClassKeys('install')) {
  703     checkParam($p);
  704 }
  705 
  706 #--------------------------------------------------------------------
  707 # sort out DOCUMENT_ROOT
  708 #--------------------------------------------------------------------
  709 my $dr;
  710 if ($use_dr) {
  711     print "** USE DOCUMENT_ROOT **\n";
  712     if (!exists($ENV{DOCUMENT_ROOT})) {
  713         while(1) {
  714             $dr = query('enter the value of $DOCUMENT_ROOT');
  715             if (-d $dr) { last; }
  716             print "\n[$dr] is not a valid directory.\n";
  717         }
  718         $ENV{DOCUMENT_ROOT} = $dr;
  719     } else {
  720         $dr = $ENV{DOCUMENT_ROOT};
  721     }
  722 }
  723 
  724 #--------------------------------------------------------------------
  725 # setup file paths
  726 #--------------------------------------------------------------------
  727 foreach my $p (getClassKeys('file')) {
  728     if (exists($VALUES{$p}) && $VALUES{$p}) {
  729         $VALS{$p} = expand($VALUES{$p});
  730     } else {
  731         my $v = default($p);
  732         $VALUES{$p} = $v;
  733         $VALS{$p} = expand($v);
  734         $VALS{$p} =~ s!//+!/!g;
  735         $DEBUG && print "got [$v]\n";
  736         $VALS{$p} =~ s/^\s+//;
  737     }
  738 }
  739 
  740 #--------------------------------------------------------------------
  741 # expand $DOCUMENT_ROOT in all parameters
  742 #--------------------------------------------------------------------
  743 if ($use_dr) {
  744     foreach my $p (keys(%VALS)) {
  745         $DEBUG && print "[$p] VALS{$p} = [$VALS{$p}]\n";
  746         if ($VALS{$p} =~ /\$DOCUMENT_ROOT/) {
  747             $DEBUG && print "%% DOC_ROOT FOUND in [$p], val=[$VALS{$p}] %%\n";
  748             $VALS{$p} =~ s/\$DOCUMENT_ROOT/$dr/;
  749             $VALS{$p} =~ s!//!/!g;
  750             $DEBUG && print "%% After subst: [$VALS{$p}] %%\n";
  751         }
  752     }
  753 }
  754 
  755 #--------------------------------------------------------------------
  756 # substitute "$ENV{DOCUMENT_ROOT}" for "$DOCUMENT_ROOT" in %values
  757 #--------------------------------------------------------------------
  758 foreach my $key (keys(%VALUES)) {
  759     if ($VALUES{$key} =~ /\$DOCUMENT_ROOT/) {
  760         $VALUES{$key} =~ s/\$DOCUMENT_ROOT/\$ENV{DOCUMENT_ROOT}/;
  761     }
  762 }
  763 
  764 if (($VALUES{map_type} ne 'client') && ($WINDOZE)) {
  765     print "A map_type of 'client' doesn't work on Windoze.\n";
  766     print "Automatically setting map_type to 'server'\n";
  767     $VALUES{map_type} = 'server';
  768 }
  769 
  770 #------------------------------------------------------------------
  771 # I have collected all parameter values, so I can now start 
  772 # creating directories (if necessary) and copying files
  773 #------------------------------------------------------------------
  774 
  775 my $migrate = ($VALS{migrate_data} eq 'yes') ? "\n- migrate data" : '';
  776 print <<_EOF_;
  777 
  778 I am about to perform the following steps:
  779 - create [$VALS{data_dir_abs}] if necessary
  780 - create [$VALS{cgi_dir_abs}] if necessary
  781 - create [$VALS{js_dir_abs}] if necessary
  782 - create [$VALS{util_dir_abs}] if necessary
  783 - copy Perl modules and scripts to [$VALS{cgi_dir_abs}]
  784 - copy HTML, README, and data files to [$VALS{data_dir_abs}]
  785 - copy JavaScript files to [$VALS{js_dir_abs}]
  786 - copy utility files to [$VALS{util_dir_abs}]
  787 - create a new top-level HTML entry point (index.html on unix)
  788 - create a new log-file in [$VALS{log_file}]
  789 - create a new image directory [$VALS{image_dir_abs}]
  790 - set parameters in AbsenceConfig.pm
  791 - change permissions on datafiles and directories
  792 - create a new empty database$migrate
  793 
  794 _EOF_
  795 
  796 if (!yesNo('are you ready', 1)) {
  797     print "installation aborted by user.\n";
  798     exit;
  799 }
  800 
  801 verbose('checking/creating directory structure');
  802 
  803 # cgi-bin-directory
  804 if (! -e $VALS{cgi_dir_abs}) {
  805     verbose("cgi-bin directory [$VALS{cgi_dir_abs}] does not exist. creating...");
  806     makePath($VALS{cgi_dir_abs}, 0755)
  807         || die "mkdir for $VALS{cgi_dir_abs} failed. err=$CMDOUT\n";
  808 }
  809 
  810 # data-directory
  811 if (! -e $VALS{data_dir_abs}) {
  812     verbose("data directory [$VALS{data_dir_abs}] does not exist. creating...");
  813     makePath($VALS{data_dir_abs}, 0755)
  814         || die "mkdir for $VALS{data_dir_abs} failed. err=$CMDOUT\n";
  815 }
  816 
  817 # image-directory
  818 if (! -d $VALS{image_dir_abs}) {
  819     verbose("image directory [$VALS{image_dir_abs}] does not exist. creating...");
  820     myMkdir($VALS{image_dir_abs}, 0770) || die "mkdir failed";
  821 }
  822 
  823 # javascript-directory
  824 if (! -d $VALS{js_dir_abs}) {
  825     verbose("javascript directory [$VALS{js_dir_abs}] does not exist. creating...");
  826     makePath($VALS{js_dir_abs}, 0750) || die "mkdir failed";
  827 }
  828 
  829 # utils-directory
  830 if (! -d $VALS{util_dir_abs}) {
  831     verbose("utility directory [$VALS{util_dir_abs}] does not exist. creating...");
  832     makePath($VALS{util_dir_abs}, 0750) || die "mkdir failed";
  833 }
  834 
  835 #------------------------------------------------------------------
  836 # figure out where source files should be
  837 #------------------------------------------------------------------
  838 my $dn = dirname($0);
  839 my $SRCDIR;
  840 print "\n";
  841 while(1) {
  842     $SRCDIR = query('where is the unpacked kit ("." is OK)', $dn);
  843     if (! -e "$SRCDIR/cgi-bin/absence.pl") {
  844         print "that doesn't seem to be right...\n";
  845     } else {
  846         last;
  847     }
  848 }
  849 
  850 #------------------------------------------------------------------
  851 # copy files into place
  852 #------------------------------------------------------------------
  853 verbose("copying cgi-bin files");
  854 foreach my $file (@cgi) {
  855     copyFile("$SRCDIR/cgi-bin/$file", $VALS{cgi_dir_abs})
  856         || die "copy of cgi-bin/$file to $VALS{cgi_dir_abs} failed. err=$CMDOUT\n";
  857 }
  858 
  859 verbose("copying misc files");
  860 foreach my $file (@misc) {
  861     copyFile("$SRCDIR/$file", $VALS{data_dir_abs})
  862         || die "copy of $file to $VALS{data_dir_abs} failed. err=$CMDOUT\n";
  863 }
  864 
  865 verbose("copying html files");
  866 foreach my $file (@html) {
  867     copyFile("$SRCDIR/html/$file", $VALS{data_dir_abs})
  868         || die "copy of html/$file to $VALS{data_dir_abs} failed. err=$CMDOUT\n";
  869 }
  870 
  871 # javascript files
  872 verbose("copying javascript files");
  873 my @files = glob("$SRCDIR/javascript/*");
  874 foreach my $file (@files) {
  875     copyFile($file, $VALS{js_dir_abs})
  876         || die "copy of $file to $VALS{js_dir_abs} failed. err=$CMDOUT\n";
  877 }
  878 
  879 @files = glob("$SRCDIR/utils/*");
  880 verbose("copying util files");
  881 foreach my $file (@files) {
  882     copyFile($file, $VALS{util_dir_abs})
  883         || die "copy of utils/$file to $VALS{util_dir_abs} failed. err=$CMDOUT\n";
  884 }
  885 
  886 #------------------------------------------------------------------
  887 # create log file
  888 #------------------------------------------------------------------
  889 verbose("creating log-file");
  890 touch($VALS{log_file}, 0660);
  891 
  892 #------------------------------------------------------------------
  893 # create HTML entry point
  894 #------------------------------------------------------------------
  895 verbose("creating index.html");
  896 createIndex();
  897 
  898 #------------------------------------------------------------------
  899 # create database
  900 #------------------------------------------------------------------
  901 verbose("creating database");
  902 my $rv = createDatabase($SRCDIR);
  903 
  904 #------------------------------------------------------------------
  905 # add countries to database
  906 #------------------------------------------------------------------
  907 if ($rv eq 'exists') {
  908     print "will not import country-list into existing DB.\n";
  909 }
  910 else {
  911     importCountries($SRCDIR);
  912 }
  913 
  914 #------------------------------------------------------------------
  915 # edit AbsenceConfig.pm
  916 #------------------------------------------------------------------
  917 verbose("editing AbsenceConfig.pm");
  918 editConfigFile("$VALS{cgi_dir_abs}/AbsenceConfig.pm", \%VALUES);
  919 
  920 #------------------------------------------------------------------
  921 # load AbsenceDB module, which is needed by AbsenceMigration and
  922 # addAdministrators().
  923 #------------------------------------------------------------------
  924 AbsenceUtils::loadAbsenceDB($VALS{cgi_dir_abs});
  925 
  926 #------------------------------------------------------------------
  927 # migrate data, if requested
  928 #------------------------------------------------------------------
  929 if ($VALUES{migrate_data} eq 'yes') {
  930     eval {
  931         AbsenceMigration::migrateData(\%VALS);
  932     };
  933     if ($@) {
  934         print "\n** migration failed. see logfile. error:\n$@\n";
  935     }
  936     else {
  937         print "migration successful.\n";
  938     }
  939 }
  940 
  941 #------------------------------------------------------------------
  942 # add admin users/people
  943 #------------------------------------------------------------------
  944 addAdministrators($rv);
  945 
  946 #------------------------------------------------------------------
  947 # worry about file and directory permissions
  948 #------------------------------------------------------------------
  949 if ($WINDOZE) {
  950     #--------------------------------------------------------------
  951     # Windoze
  952     #--------------------------------------------------------------
  953     print <<'   _EOF_';
  954 
  955     Your platform is windows, so I'm going to let you worry about file
  956     and directory permissions.  I can offer these hints:
  957     - $VALS{cgi_dir_abs} should be executable for scripts.
  958     - $VALS{data_dir_abs} whould be writable.
  959 
  960     You will probably need to create two virtual directories, one called
  961     "absence", pointing to {$VALS{data_dir_abs}", the
  962     other called "cgi-bin" pointing to "$VALS{cgi_dir_abs}".
  963 
  964     Also, remember that multiple instances won't work on windoze.
  965     _EOF_
  966     exit;
  967 }
  968 
  969 #--------------------------------------------------------------
  970 # UNIX
  971 #--------------------------------------------------------------
  972 print <<_EOF_;
  973 
  974 There are two ways of setting up file and directory permissions:
  975 The quick-n-dirty way of the proper way.
  976 
  977 The quick-n-dirty is not desirable because it causes various
  978 files and directories to be set world-writable and world-executable.
  979 This makes it insecure.  The Proper method uses group permissions
  980 to allow the webserver process(es) access to the files in question.
  981 
  982 Use the proper method if you can.
  983 
  984 Quick-n-dirty:
  985   - set mode on data_dir_abs to     0777
  986   - set mode on image_dir_abs to    0777
  987   - set mode on log_file to     0666
  988 
  989 Proper:
  990   - set group, mode on data_dir_abs to    <webserver>, 0770
  991   - set group, mode on image_dir_abs to   <webserver>, 0770
  992   - set group, mode on log_file to    <webserver>, 0660
  993 
  994 The catch to the proper way is that some steps must be
  995 performed as root.  To that end this script will generate
  996 a small bourne-shell script to be executed by root.
  997 
  998 Please select the method you want to use.
  999 
 1000 _EOF_
 1001 
 1002 my $root_script;
 1003 my $ans = query('(q) quick-n-dirty / (p) proper', 'p', ['p', 'q']);
 1004 if (lc($ans) eq 'q') {
 1005     quickPermissions();
 1006     print "finished with installation\n";
 1007 } else {
 1008     $root_script = properPermissions();
 1009     print basename($0)." finished.  Please run '$root_script' as root\n";
 1010 }
 1011 
 1012 if (!$WINDOZE) {
 1013     print "\nThe author of absence is curious about who is using it,\n";
 1014     print "and would like to send a mail to himself via this script.\n";
 1015     print "answer no if you don't want to or don't have a direct connection\n";
 1016     print "to the internet.\n";
 1017 
 1018     if (yesNo('Send a mail to author', 1)) {
 1019         sendMail();
 1020     }
 1021 }
 1022 
 1023 if ($ans eq 'p') {
 1024     my $str = "** Don't forget to run '$root_script' as root! **";
 1025     my $len = length($str);
 1026     print "\n", '*' x $len, "\n", $str, "\n", '*' x $len, "\n";
 1027 }
 1028 
 1029 exit;
 1030 
 1031 #======================================================================
 1032 # subroutines
 1033 #======================================================================
 1034 
 1035 sub addAdministrators
 1036 {
 1037     my $db_status = shift;
 1038 
 1039     if ($VALUES{authentication} ne 'yes') {
 1040         return;
 1041     }
 1042 
 1043     if ($db_status eq 'exists' && !yesNo('do you need to add an administrator?', 1))
 1044     {
 1045         return;
 1046     }
 1047 
 1048     verbose("adding administrators");
 1049 
 1050     if ($DEBUG) {
 1051         print "debug-mode, will not add administrators.\n";
 1052         return;
 1053     }
 1054 
 1055     print "\n** adding administrators **\n";
 1056     print "\nYou must add at least one priviledged user to the system.\n";
 1057 
 1058     my $get_pw = ($VALUES{manage_password} eq 'yes');
 1059 
 1060     my $super_acl = {
 1061         level   => 4,
 1062         target  => 'all',
 1063     };
 1064 
 1065     #----------------------------------------
 1066     # loop until no more are desired
 1067     #----------------------------------------
 1068     while(1) {
 1069         my $pw = '';
 1070         my $user = query('Enter  Username', '');
 1071         if ($get_pw) {
 1072             $pw = query('Enter Password', '');
 1073         }
 1074         my $ret = AbsenceDB::addUser($user, $pw, [], [ $super_acl ]);
 1075         if ($ret eq 'ok') {
 1076             print "sucessfully added [$user]\n";
 1077         } elsif ($ret eq 'duplicate') {
 1078             print "[$user] already exists in database.\n";
 1079         } else {
 1080             print "error adding new user. (ret=[$ret])\n";
 1081         }
 1082         print "\n";
 1083         if (yesNo('done adding admin users', 'yes')) {
 1084             last;
 1085         }
 1086     }
 1087     print "done adding users.\n";
 1088 }
 1089 
 1090 sub checkParam
 1091 {
 1092     my $p = shift;
 1093 
 1094     if (exists($VALUES{$p}) && $VALUES{$p}) {
 1095         if ($VALUES{$p} eq 'undef') {
 1096             $VALUES{$p} = undef;
 1097         }
 1098         $VALS{$p} = expand($VALUES{$p});
 1099     } else {
 1100         my $v = queryParam($p);
 1101         if ($v eq 'undef') {
 1102             $VALS{$p} = $VALUES{$p} = undef;
 1103         } else {
 1104             $VALUES{$p} = $v;
 1105             $VALS{$p} = expand($v);
 1106             $VALS{$p} =~ s!//+!/!g;         # remove multiple slashes
 1107             $DEBUG && print "got [$v]\n";
 1108             $VALS{$p} =~ s/^\s+//;          # remove all white-space
 1109         }
 1110     }
 1111 }
 1112 
 1113 # not currently used
 1114 sub getAllClasses
 1115 {
 1116     my %classes;
 1117     foreach my $key (keys(%PARMS)) {
 1118         my $class = $PARMS{$key}->{class};
 1119         $classes{$class} = 1;
 1120     }
 1121 
 1122     return keys(%classes);
 1123 }
 1124 
 1125 sub getClassKeys
 1126 {
 1127     my @classes = @_;
 1128 
 1129     if ($classes[0] eq 'all') {
 1130         # I list them here to control the order
 1131         @classes = qw(path file script param param-db param-multi param-holiday param-auth param-auth-simple param-auth-http param-skip install);
 1132     }
 1133 
 1134     my @out;
 1135     my @tmp;
 1136     foreach my $class (@classes) {
 1137         foreach my $p (keys(%PARMS)) {
 1138             if ($PARMS{$p}->{class} eq $class) {
 1139                 push(@tmp, $p);
 1140             }
 1141         }
 1142         push(@out, sort @tmp);
 1143         @tmp = ();
 1144     }
 1145 
 1146     @out;
 1147 }
 1148 
 1149 sub sendMail
 1150 {
 1151     # only know how to send mail
 1152     my @list = glob('/usr/*bin/sendmail');
 1153     if (!@list) {
 1154         print "can't find sendmail, giving up.\n";
 1155         return;
 1156     }
 1157 
 1158     print "I hope you don't mind answering a few questions...\n";
 1159     print "The default answer is 'n/a'.  Feel free to leave the default.\n";
 1160     my $purpose = query('What do you intend to do with absence', 'n/a');
 1161     my $company = query('What does your company do', 'n/a');
 1162     my $name = query('What is your name?', 'n/a');
 1163     my $comments = query('Would you like to make any comments', 'none');
 1164 
 1165     my $fh = FileHandle->new("|$list[0] urban\@unix-beratung.de");
 1166     print $fh <<_EOF_;
 1167 To: urban\@unix-beratung.de
 1168 Subject: someone using absence
 1169 
 1170 purpose: $purpose
 1171 company does: $company
 1172 user: $name
 1173 comments: $comments
 1174 _EOF_
 1175 
 1176     print "Thanks!\n";
 1177 }
 1178 
 1179 sub docRoot
 1180 {
 1181     $ENV{DOCUMENT_ROOT};
 1182 }
 1183 
 1184 sub expand
 1185 {
 1186     my $rhs = shift;
 1187     defined($rhs) || return undef;
 1188 
 1189     #if ($rhs =~ /\$/) {
 1190     #   $rhs =~ s/\${([^}]+)}/substitute($1)/ge;
 1191     #}
 1192 
 1193     while($rhs =~ /\${([^}]+)}/) {
 1194         $rhs =~ s/\${([^}]+)}/substitute($1)/ge;
 1195     }
 1196     return $rhs;
 1197 }
 1198 
 1199 sub substitute
 1200 {
 1201     my $vname = shift;
 1202 
 1203     if (exists($VALUES{$vname})) {
 1204         return $VALUES{$vname};
 1205     } else {
 1206         die "no var found";
 1207     }
 1208 
 1209 }
 1210 
 1211 sub quickPermissions
 1212 {
 1213     my %PERMS = (
 1214         $VALS{data_dir_abs}     => 0777,
 1215         $VALS{image_dir_abs}    => 0777,
 1216         $VALS{log_file}         => 0666,
 1217     );
 1218 
 1219     foreach my $file (keys(%PERMS)) {
 1220         my $p = sprintf('0%o', $PERMS{$file});
 1221         verbose("setting [$file] to [$p]");
 1222         $DEBUG || chmod($PERMS{$file}, $file);
 1223     }
 1224 }
 1225 
 1226 sub properPermissions
 1227 {
 1228     my %PERMS = (
 1229         $VALS{data_dir_abs}     => 0770,
 1230         $VALS{image_dir_abs}    => 0770,
 1231         $VALS{js_dir_abs}       => 0750,
 1232         $VALS{log_file}         => 0660,
 1233     );
 1234 
 1235     # first try to figure out if there is a group for the webserver
 1236     my @grps = findWebGroup();
 1237     my $grp;
 1238     my $def;
 1239     if (@grps) {
 1240         print "Please tell me what under what group the webserver runs.\n";
 1241         print "I found the following possibilities: ".join(', ', @grps)."\n";
 1242         $def = $grps[0];
 1243     } else {
 1244         print "I was unable to find any groups that the webserver might use\n";
 1245         print "Please tell me what under what group the webserver runs.\n";
 1246     }
 1247 
 1248     while(1) {
 1249         $grp = query('Which group shall I use ("none" to give up)', $def);
 1250         if ($grp eq 'none') {
 1251             last;
 1252         }
 1253         if (getgrnam($grp)) { last; }
 1254         print "\ngroup [$grp] does not exist.\n";
 1255     }
 1256 
 1257     if ($grp eq 'none') {
 1258         print <<_EOF_;
 1259 Manual instructions:
 1260 You must determine what group your web-server runs under and
 1261 than set the group and mode of the following files:
 1262 
 1263 _EOF_
 1264         printf("%-50s  %-11s %s\n", 'File', 'Group', 'Mode');
 1265         foreach my $file (keys(%PERMS)) {
 1266             printf("%-50s  %-11s  0%o\n", $file, 'web-group', $PERMS{$file});
 1267         }
 1268         return;
 1269     }
 1270 
 1271     my $rs = "$SRCDIR/root-script.sh";
 1272     my $fh = FileHandle->new;
 1273     open($fh, ">$rs") || die "open [$rs] for writing";
 1274     print $fh "#!/bin/sh\n\n";
 1275     if (exists($ENV{DOCUMENT_ROOT})) {
 1276         print $fh "DOCUMENT_ROOT=$ENV{DOCUMENT_ROOT}\n";
 1277     }
 1278     foreach my $file (keys(%PERMS)) {
 1279         my $perms = $PERMS{$file};
 1280         my $p = sprintf('0%o', $perms);
 1281         verbose("(group,mode) for [$file] --> ($grp, $p)");
 1282         print $fh "\nchgrp $grp $file\n";
 1283         printf $fh "chmod 0%o $file\n", $perms;
 1284     }
 1285     $fh->close;
 1286     chmod(0755, $rs) || die "chmod: $!";
 1287 
 1288     $rs;
 1289 }
 1290 
 1291 # only used on U*X platforms
 1292 sub findWebGroup
 1293 {
 1294     my $group;
 1295 
 1296     my @out;
 1297     my $fh = FileHandle->new('/etc/group') || die 'open /etc/group to read';
 1298     while(<$fh>) {
 1299         $group = (split(':', $_))[0];
 1300         if ($group =~ /(httpd|apach|web|www)/) {
 1301             push(@out, $group);
 1302         }
 1303     }
 1304     $fh->close;
 1305 
 1306     @out;
 1307 }
 1308 
 1309 sub touch
 1310 {
 1311     my ($file, $mode) = @_;
 1312 
 1313     if (-e $file) {
 1314         verbose("touch: [$file] exists. do nothing.");
 1315         return;
 1316     }
 1317 
 1318     my $m = sprintf('0%o', $mode);
 1319     verbose("touching [$file] with mode = ($m)");
 1320     $DEBUG && return;
 1321 
 1322     my $fh = FileHandle->new;
 1323     open($fh, ">$file") || die "touch on $file failed";
 1324     $fh->close;
 1325     chmod($mode, $file) || die "chmod: $!";
 1326 }
 1327 
 1328 sub createIndex
 1329 {
 1330     my $index_file = "$VALS{data_dir_abs}/"
 1331         .($WINDOZE ? 'Default.htm' : 'index.html');
 1332 
 1333     if ($DEBUG) {
 1334         $index_file = '/tmp/index.html';
 1335         print "setting index file to /tmp/index.html\n";
 1336     }
 1337 
 1338     my $fh = FileHandle->new;
 1339     open($fh, ">$index_file") || die "open [$index_file] for writing";
 1340     my $cgirel = $VALS{cgi_dir_rel};
 1341     print $fh <<_EOF_;
 1342 <HTML>
 1343 <HEAD>
 1344 <TITLE>Absence</TITLE>
 1345 </HEAD>
 1346 <FRAMESET ROWS="60,*">
 1347     <FRAME SRC="$cgirel/absence-control.pl" NAME=control FRAMEBORDER=0>
 1348     <FRAME SRC="$cgirel/absence.pl" name=display>
 1349 </FRAMESET>
 1350 </HTML>
 1351 _EOF_
 1352     $fh->close;
 1353     chmod(0644, $index_file) || die "chmod: $!";
 1354 }
 1355 
 1356 sub verbose
 1357 {
 1358     my $str = shift;
 1359 
 1360     $VERBOSE && print "$str\n";
 1361 }
 1362 
 1363 sub copyFile
 1364 {
 1365     my ($src, $targ) = @_;
 1366 
 1367     my $cmd;
 1368     if ($WINDOZE) {
 1369         $src =~ s!/+!\\!g;
 1370         $targ =~ s!/+!\\!g;
 1371         $cmd = "copy $src $targ";
 1372     } else {
 1373         $cmd = "cp $src $targ";
 1374     }
 1375 
 1376     myExec($cmd);
 1377 }
 1378 
 1379 sub copyDir
 1380 {
 1381     my ($src, $targ) = @_;
 1382     my $cmd;
 1383     $cmd = "cp -r $src $targ";
 1384     myExec($cmd);
 1385 }
 1386 
 1387 
 1388 sub makePath
 1389 {
 1390     my ($path, $mode) = @_;
 1391 
 1392     if (-d $path) { return 1; }
 1393 
 1394     my $cmd;
 1395     if ($WINDOZE) {
 1396         $path =~ s!/+!\\!g;
 1397         $cmd = "mkdir $path";
 1398     } else {
 1399         $cmd = "mkdir -p $path";
 1400     }
 1401 
 1402     myExec($cmd);
 1403 
 1404     if ($mode && !$DEBUG) {
 1405         chmod($mode, $path) || die "chmod $mode $path failed: $!";
 1406     }
 1407 }
 1408 
 1409 sub myMkdir
 1410 {
 1411     my ($file, $perms) = @_;
 1412 
 1413     my $m = sprintf('0%o', $perms);
 1414     verbose("CMD: mkdir($file, $m)");
 1415     $DEBUG && return 1;
 1416 
 1417     return mkdir($file, $perms);
 1418 }
 1419 
 1420 sub myExec
 1421 {
 1422     my $cmd = shift;
 1423 
 1424     verbose("execing cmd [$cmd]");
 1425     $DEBUG && return 1;
 1426 
 1427     $CMDOUT = `$cmd 2>&1`;
 1428 
 1429     #print "return value: [$?]\n";
 1430 
 1431     die "cmd [$cmd] failed: $CMDOUT\n" if ($?);
 1432     #return $? ? 0 : 1;
 1433     return 1;
 1434 }
 1435 
 1436 sub usage
 1437 {
 1438     print "usage: $0 [options]\n options:\n";
 1439     my ($short, $long, $desc, $both);
 1440     printf(" %-15s  %s\n", '-h', 'print help (this)');
 1441     #printf(" %-15s  %s\n", '-f', "(f)orce. be bold.");
 1442     printf(" %-15s  %s\n\n", '-dr <DOCROOT>', "set \$DOCUMENT_ROOT to next arg");
 1443     print " configuration parameters:\n";
 1444     printf("%-5s %-18s %-27s %s\n",'short', 'long', 'description', '[default]');
 1445     printf("%-5s %-18s %-27s %s\n",'-----', '----', '-----------', '--------');
 1446 
 1447     foreach (getClassKeys('all')) {
 1448         $short = $PARMS{$_}->{short};
 1449         $desc = $PARMS{$_}->{desc};
 1450         $desc =~ s/relative/rel./;
 1451         $desc =~ s/absolute/abs./;
 1452         $short = "$short";
 1453         $long = "$_";
 1454         $both = "$short / $long";
 1455         printf(" %-4s %-18s %-27s [%s]\n", $short, $long, $desc, default($_));
 1456     }
 1457 }
 1458 
 1459 sub inList
 1460 {
 1461     my ($thing, $lref) = @_;
 1462 
 1463     foreach (@{$lref}) {
 1464         if ($thing eq $_) {
 1465             return 1;
 1466         }
 1467     }
 1468 
 1469     0;
 1470 }
 1471 
 1472 sub queryParam
 1473 {
 1474     my $p = shift;
 1475 
 1476     my $default = default($p);
 1477     my $desc = $PARMS{$p}->{desc};
 1478     my $allow = $PARMS{$p}->{allow};
 1479     my $none = exists($PARMS{$p}->{none}) ? $PARMS{$p}->{none} : 0;
 1480     my $undef = exists($PARMS{$p}->{undef}) ? $PARMS{$p}->{undef} : 0;
 1481     if (($p eq 'data_dir_abs') || ($p eq 'cgi_dir_abs')) {
 1482       print "\n[You may want to use \$DOCUMENT_ROOT in the path below]\n";
 1483     }
 1484 
 1485     if (exists($PARMS{$p}->{extra})) {
 1486         print "$PARMS{$p}->{extra}\n\n";
 1487     }
 1488     return query($desc, $default, $allow, $none, $undef);
 1489 }
 1490 
 1491 sub query_param_old
 1492 {
 1493     my $p = shift;
 1494 
 1495     my $default = default($p);
 1496     my $ans;
 1497     my $desc = $PARMS{$p}->[1];
 1498     my $def = ($default) ? " [$default]" : '';
 1499     my $qs = "$desc${def}? ";
 1500     while(!$ans) {
 1501         print "$qs";
 1502         chomp($ans = <STDIN>);
 1503         if (!length($ans) && $default) {
 1504             $ans = $default;
 1505         }
 1506     }
 1507 
 1508     $ans;
 1509 }
 1510 
 1511 sub default
 1512 {
 1513     my $p = shift;
 1514 
 1515     my $default;
 1516     my $path = 0;
 1517     my $def = $PARMS{$p}->{def};
 1518     if ($def) {
 1519         my @list = ref($def) ? @{$def} : $def;
 1520         my @new;
 1521         foreach (@list) {
 1522             if (exists($PARMS{$_})) {
 1523                 $path = 1;
 1524                 push(@new, "\${$_}");
 1525             } elsif ($_ eq 'name') {
 1526                 push(@new, $PARMS{$p}->{name});
 1527             } else {
 1528                 push(@new, $_);
 1529             }
 1530         }
 1531         #if ($path) {
 1532             $default = join('/', @new);
 1533         #} else {
 1534         #   $default = $args[0];
 1535         #}
 1536     }
 1537 
 1538     $default;
 1539 }
 1540 
 1541 sub editConfigFile
 1542 {
 1543     my ($cf_path, $vref) = @_;
 1544 
 1545     $DEBUG && return;
 1546 
 1547     verbose("editing [$cf_path]");
 1548 
 1549     my $debug = 0;
 1550     my %fixed;
 1551 
 1552     my $fh = FileHandle->new($cf_path) || die "file not found [$cf_path]\n";
 1553     my @lines = <$fh>;
 1554     $fh->close;
 1555 
 1556     my @new;
 1557     my $looking = 1;
 1558     foreach (@lines) {
 1559         $debug && print ">> $_";
 1560         chomp;
 1561         if ($looking) {
 1562             if (/^\s*#/) { push(@new, $_); next; }
 1563             if (/^((?:my)?\s+\$?)(\S+)(\s*=>?\s*)(['"]?[^'";,]+['"]?)([;,]\s*(#.*)?)$/) {
 1564                 my ($pre, $varname, $mid, $val, $end) = ($1, $2, $3, $4, $5);
 1565                 $debug && print "  pre=[$pre] vn=[$varname] mid=[$mid] val=[$val] end=[$end]\n";
 1566                 if (exists($vref->{$varname}) && !exists($fixed{$varname})) {
 1567                     $debug && print "replacing [$val] with [$vref->{$varname}]\n";
 1568                     my $tmp = quote($vref->{$varname});
 1569                     push(@new, "$pre$varname$mid$tmp$end");
 1570                     $fixed{$varname} = 1;
 1571                 } else {
 1572                     push(@new, $_);
 1573                 }
 1574             } else {
 1575                 push(@new, $_);
 1576             }
 1577         } else {
 1578             push(@new, $_);
 1579         }
 1580         if (/%%END_MARKER%%/) { $looking = 0; }
 1581     }
 1582 
 1583     my $dn = dirname($cf_path);
 1584     my $tmpfile = "$dn/cf-$$";
 1585     $fh = FileHandle->new;
 1586     open($fh, ">$tmpfile") || die "open [$tmpfile] for writing";
 1587     foreach (@new) {
 1588         print $fh "$_\n";
 1589     }
 1590     $fh->close;
 1591     chmod(0644, $tmpfile) || die "chmod: $!";
 1592 
 1593     if ($DEBUG) {
 1594         print "leaving edited AbsenceConfig as [$tmpfile]\n";
 1595         return;
 1596     }
 1597 
 1598     rename($tmpfile, $cf_path) || die "rename failed";
 1599 }
 1600 
 1601 sub quote
 1602 {
 1603     my $val = shift;
 1604 
 1605     defined($val) || return 'undef';
 1606 
 1607     if ($val =~ /\$/) {
 1608         return qq["$val"];
 1609     } else {
 1610         return qq['$val'];
 1611     }
 1612 }
 1613 
 1614 #-------------------------------------------------------------------
 1615 # Database stuff
 1616 #-------------------------------------------------------------------
 1617 sub createDatabase
 1618 {
 1619     my $srcdir = shift;
 1620 
 1621     my $db_exists = 0;
 1622     my $retval;
 1623 
 1624     my $sql_file = "$srcdir/db/create_tables.sql";
 1625 
 1626     -f $sql_file || die "sql-file [$sql_file] not found\n";
 1627 
 1628     if ($DEBUG) {
 1629         print "debug-mode, will not create database.\n";
 1630         return;
 1631     }
 1632 
 1633     my %admin_params = (
 1634         a_user      => $VALUES{database_adm_user},
 1635         a_pass      => $VALUES{database_adm_pass},
 1636     );
 1637 
 1638     if (defined($VALUES{database_host}) &&
 1639         ($VALUES{database_host} ne 'localhost'))
 1640     {
 1641         $admin_params{host} = $VALUES{database_host};
 1642     }
 1643 
 1644     my %params = (
 1645         db_user     => $VALUES{database_user},
 1646         db_pass     => $VALUES{database_pass},
 1647         create_db   => 1,
 1648     );
 1649 
 1650     print <<_EOF_;
 1651 
 1652     To create the database you need an absence-specific db-user which
 1653     has permission to create a database (CREATEDB).  If you have access
 1654     to the db-superuser (normally "postgres") you can create the
 1655     absence db-user.  Otherwise, the absence db-user needs to exist.
 1656 
 1657     How shall I proceed?
 1658         (create)    - create absence db-user
 1659         (exists)    - absence db-user already exists
 1660         (abort)     - abort installation
 1661 
 1662 _EOF_
 1663 
 1664     
 1665     my $ans = query('create/exists/abort', 'abort', [qw/create exists abort/]);
 1666 
 1667     if ($ans eq 'create') {
 1668         if (AbsenceInstall::adminCheckUser(
 1669                 %admin_params,
 1670                 user => $VALUES{database_user}
 1671             )
 1672         )
 1673         {
 1674             print "user already exists, re-using.\n";
 1675         } else {
 1676             verbose("creating absence user [$VALUES{database_user}] ...");
 1677             AbsenceInstall::adminCreateAbsenceUser(%admin_params, %params);
 1678         }
 1679     }
 1680     elsif ($ans eq 'exists') {
 1681         my $cu = AbsenceInstall::checkUser(%params);
 1682         if ($cu eq 'not_exist') {
 1683             print "db-user [$params{db_user}] does not exist. abort.\n";
 1684             exit 0;
 1685         }
 1686         elsif ($cu eq 'no_createdb') {
 1687             print "db-user [$params{db_user}] does not have CREATEDB right. abort.\n";
 1688             exit 0;
 1689         }
 1690         else {
 1691             print "proceeding with installation.\n";
 1692         }
 1693     }
 1694     else {
 1695         print "user aborted installation.\n";
 1696         exit 0;
 1697     }
 1698 
 1699     if (AbsenceInstall::checkDatabase(%params, db => $VALUES{database_name}))
 1700     {
 1701         print "\ndatabase [$VALUES{database_name}] exists.\n"
 1702             . "you have three choices:\n"
 1703             . "\t(drop) - drop database and create new\n"
 1704             . "\t(cont) - continue with current database\n"
 1705             . "\t(abort)    - abort installation\n\n";
 1706 
 1707         my $ans = query('What would you like to do?', 'abort', [qw/drop cont abort/]);
 1708         if ($ans eq 'drop') {
 1709             AbsenceInstall::dropDatabase(%admin_params,
 1710                 db => $VALUES{database_name});
 1711             $retval = 'created';
 1712         }
 1713         elsif ($ans eq 'cont') {
 1714             print "continuing installation with current database...\n";
 1715             $db_exists = 1;
 1716             $retval = 'exists';
 1717         }
 1718         elsif ($ans eq 'abort') {
 1719             print "aborting installation!\n";
 1720             exit 0;
 1721         }
 1722     }
 1723 
 1724     if (!$db_exists) {
 1725         verbose("creating database [$VALUES{database_name}] ...");
 1726 
 1727         AbsenceInstall::createAbsenceDb(
 1728             user        => $VALUES{database_user},
 1729             pass        => $VALUES{database_pass},
 1730             host        => $VALUES{database_host},
 1731             name        => $VALUES{database_name},
 1732         );
 1733 
 1734         verbose("populating database ...");
 1735 
 1736         AbsenceInstall::populateDatabase(
 1737             user        => $VALUES{database_user},
 1738             pass        => $VALUES{database_pass},
 1739             name        => $VALUES{database_name},
 1740             host        => $VALUES{database_host},
 1741             file        => $sql_file,
 1742         );
 1743     }
 1744 
 1745     return $retval;
 1746 }
 1747 
 1748 sub importCountries
 1749 {
 1750     my $srcdir = shift;
 1751 
 1752     AbsenceImport::init(
 1753         $VALUES{database_user},
 1754         $VALUES{database_pass}, 
 1755         $VALUES{database_name}, 
 1756         $VALUES{database_host}, 
 1757     );
 1758 
 1759     verbose("loading country names and codes into database");
 1760 
 1761     my $input_file = "$srcdir/misc/iso3166-countrycodes.txt";
 1762     my $fh = FileHandle->new($input_file);
 1763     defined($fh)
 1764         || die "failed to open iso-country-code file [$input_file]: $!";
 1765     my $parsing = 0;
 1766     my @list;
 1767     while(<$fh>) {
 1768         chomp;
 1769         next if (/^\s*$/);
 1770         if ($parsing) {
 1771             if (/^(\S+(?:\s+\S+)*?)\s+(\S{2})\s+(\S{3})\s+(\d{3})\s*$/) {
 1772                 my ($name, $two, $three, $num) = ($1, $2, $3, $4);
 1773                 push(@list, { code => $two, name => $name });
 1774             }
 1775         }
 1776         elsif (/^-{50,}$/) {
 1777             $parsing = 1;
 1778         }
 1779     }
 1780     $fh->close;
 1781 
 1782     AbsenceImport::loadCountryTable(\@list);
 1783 }