"Fossies" - the Fresh Open Source Software Archive

Member "absence-v2.1/utils/AbsenceUtils.pm" (20 Oct 2013, 7314 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 "AbsenceUtils.pm" see the Fossies "Dox" file reference documentation.

    1 #======================================================================
    2 #    This file is part of Absence.
    3 #
    4 #    Absence is free software: you can redistribute it and/or modify
    5 #    it under the terms of the GNU General Public License as published by
    6 #    the Free Software Foundation, either version 3 of the License, or
    7 #    (at your option) any later version.
    8 #
    9 #    Absence is distributed in the hope that it will be useful,
   10 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
   11 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   12 #    GNU General Public License for more details.
   13 #
   14 #    You should have received a copy of the GNU General Public License
   15 #    along with Absence.  If not, see <http://www.gnu.org/licenses/>.
   16 #======================================================================
   17 
   18 # copyright Robert Urban
   19 
   20 package AbsenceUtils;
   21 
   22 use FileHandle;
   23 use IPC::Open3;
   24 use IO::Select;
   25 use POSIX ":sys_wait_h";
   26 use English;
   27 use DBI;
   28 use Encode;
   29 
   30 use Exporter;
   31 @ISA = qw(Exporter);
   32 @EXPORT = qw(query yesNo inList loadAbsenceDB connectDb executeSql runCommand);
   33 @EXPORT_OK = qw(query yesNo inList loadAbsenceDB connectDb executeSql runCommand);
   34 
   35 use strict;
   36 
   37 # package globals
   38 
   39 my $VERBOSE = 1;
   40 my $DEBUG   = 0;
   41 
   42 sub loadAbsenceDB
   43 {
   44     my ($libdir, $logfile) = @_;
   45 
   46     my $found = 0;
   47     foreach my $dir (@INC) {
   48         if ($dir eq $libdir) {
   49             $found = 1;
   50         }
   51     }
   52 
   53     if (!$found) {
   54         push(@INC, $libdir);
   55     }
   56 
   57     $logfile = '/dev/null' unless(defined($logfile));
   58 
   59     eval {  
   60         require "$libdir/AbsenceConfig.pm";
   61         require "$libdir/AbsenceLog.pm";
   62         AbsenceLog->import(LOGFILE => $logfile);
   63         require "$libdir/AbsenceDB.pm";
   64     };
   65     if ($@) {
   66         print "Error while trying to load absence modules:\n$@\n";
   67         exit 1;
   68     }
   69 }
   70 
   71 sub query
   72 {
   73     my ($prompt, $default, $allowed, $none, $undef) = @_;
   74 
   75     my $ans;
   76     my $def = length($default) ? " [$default]" : '';
   77     if (ref($allowed)) {
   78         ($none || $undef) && push(@{$allowed}, 'none');
   79         $prompt .= ' ('.join('/', @{$allowed}).')';
   80     } elsif ($none || $undef) {
   81         $prompt .= ' ("none" for none)';
   82     }
   83     my $qs = "$prompt${def}? ";
   84     while(!length($ans)) {
   85         print "$qs";
   86         chomp($ans = <STDIN>);
   87         if (!length($ans) && $default) {
   88             $ans = $default;
   89         }
   90         if ($ans) {
   91             if ($allowed) {
   92                 if (ref($allowed)) {
   93                     if (!inList($ans, $allowed)) {
   94                         print 'must be one of ('.join(',', @{$allowed}).")\n";
   95                         $ans = '';
   96                     }
   97                 } elsif ($none && ($ans eq 'none')) {
   98                     $ans = '';
   99                     last;
  100                 } elsif ($undef && ($ans eq 'undef' || $ans eq 'none')) {
  101                     $ans = undef;
  102                     last;
  103                 } elsif ($ans !~ /^$allowed$/) {
  104                     print "not a valid answer.\n";
  105                     $ans = '';
  106                 }
  107             }
  108         }
  109     }
  110 
  111     return $ans;
  112 }
  113 
  114 sub yesNo
  115 {
  116     my ($prompt, $default) = @_;
  117 
  118     if ($default =~ /^1|0$/) {
  119         $default = ($default == 1) ? 'yes' : 'no';
  120     }
  121     my $ans = query($prompt, $default, ['yes', 'no', 'y', 'n']);
  122     if ($ans =~ /^y/i) {
  123         return 1;
  124     }
  125     return 0;
  126 }
  127 
  128 sub inList
  129 {
  130     my ($thing, $lref) = @_;
  131 
  132     foreach (@{$lref}) {
  133         if ($thing eq $_) {
  134             return 1;
  135         }
  136     }
  137 
  138     0;
  139 }
  140 
  141 sub connectDb
  142 {
  143     my ($user, $pass, $name, $host, $port) = @_;
  144 
  145     my $cs = "dbi:Pg:dbname=$name";
  146     if (defined($host)) {
  147         $cs .= ";host=$host";
  148     }
  149 
  150     if (defined($port)) {
  151         $cs .= ";port=$port";
  152     }
  153 
  154     my $dbh = DBI->connect($cs, $user, $pass,
  155         {AutoCommit => 1, RaiseError => 0});
  156     
  157     return $dbh;
  158 }
  159 
  160 sub executeSql
  161 {
  162     my ($dbh, $sql) = @_;
  163 
  164     ($VERBOSE > 1) && print "SQL to be executed:\n$sql\n";
  165     $DEBUG && return 1;
  166 
  167     return defined($dbh->do($sql)) ? 1 : 0;
  168 }
  169 
  170 #-------------------------------------------------------------------------
  171 # runCommand()
  172 # ------------
  173 # runs an external command, optionally providing input via STDIN. reads
  174 # STDOUT and STDERR separately.
  175 #
  176 # params:
  177 #   -cmd    => [ 'external-command', 'and', 'its', 'params']
  178 #   -su     => [ 'user', 'group' ]  # switch to user/group before running
  179 #   -input  => [ @lines_of_input ]  # lines will be fed to program (NL is added)
  180 #-------------------------------------------------------------------------
  181 sub runCommand
  182 {
  183     my %args = @_;
  184 
  185     my $debug = 0;
  186 
  187     my @cmd = @{ $args{-cmd} };
  188 
  189     my $reset_uid = 0;
  190     my ($old_euid, $old_egid);
  191     if (exists($args{-su})) {
  192         ($old_euid, $old_egid) = ($EUID, $EGID);
  193         (ref($args{-su}) eq 'ARRAY') || die "must supply [user, group] for -su";
  194 
  195         my $new_gid = getgrnam($args{-su}->[1]);
  196         defined($new_gid) || die "group [$args{-su}->[1]] unknown\n";
  197         $EGID = "$new_gid $new_gid";
  198 
  199         my $new_uid = getpwnam($args{-su}->[0]);
  200         defined($new_uid) || die "user [$args{-su}->[0]] unknown\n";
  201         $EUID = $new_uid;
  202 
  203         $reset_uid = 1;
  204     }
  205 
  206     my @input = exists($args{-input}) ? @{$args{-input}} : ();
  207     my ($read_fh, $write_fh, $err_fh);
  208 
  209     $debug && print "run_command()\n";
  210 
  211     $debug && print "CMD: [", join(' ', @cmd), "]\n";
  212 
  213     my $child_status;
  214 
  215     $SIG{PIPE} = 'IGNORE';
  216 
  217     $SIG{CHLD} = sub {
  218         $debug && print "got SIGCHLD!!!\n";
  219         if (waitpid(-1, WNOHANG) > 0) {
  220             $child_status = $?;
  221         }
  222     };
  223 
  224     $err_fh = FileHandle->new;  # only reader and writer are auto-generated
  225     $debug && print "calling open3...\n";
  226     my $pid = open3($write_fh, $read_fh, $err_fh, @cmd);
  227 
  228     # read output until EOF
  229     my ($rout, $rin, $wout, $win, $eout, $ein);
  230     $rin = $ein = '';
  231     my ($buf, $ret, $out, $err);
  232 
  233     my ($fileno_write, $fileno_err, $fileno_read);
  234 
  235     my $sel_r = IO::Select->new;
  236     my $sel_w = undef;
  237 
  238     if (@input) {
  239         $sel_w = IO::Select->new($write_fh);
  240         $win = '';
  241         $debug && print "have input, leaving input-fh open...\n";
  242     } else {
  243         $debug && print "no input, closing input-fh ...\n";
  244         close($write_fh);
  245     }
  246 
  247     if (fileno($read_fh)) {
  248         $sel_r->add($read_fh);
  249         $debug && print "read-fh defined...\n";
  250     }
  251 
  252     if (fileno($err_fh)) {
  253         $sel_r->add($err_fh);
  254         $debug && print "err-fh defined...\n";
  255     }
  256 
  257     my $input_line;
  258     my %result;
  259 
  260     $debug && print "  going into read loop...\n";
  261     while ($sel_r->handles) {
  262         $debug && print "\n**** top of while ****\n";
  263 
  264         $debug && print "going into select...\n";
  265         my @ready = IO::Select->select($sel_r, $sel_w, undef, undef);
  266 
  267         # READ
  268         if (@{$ready[0]}) {
  269             for my $fh (@{ $ready[0] }) {
  270                 my $label = ($fh == $read_fh) ? 'out' : 'err';
  271                 $debug && print "std$label has something...\n";
  272                 $ret = sysread($fh, $buf, 512);
  273                 $debug && print "read [$ret] bytes\n";
  274                 if ($ret == 0) {
  275                     $debug && print "hit end of STD$label. closing\n";
  276                     $sel_r->remove($fh);
  277                     $fh->close;
  278                 } else {
  279                     $result{$label} .= $buf;
  280                     $debug && print "[$label] = $buf\n";
  281                 }
  282             }
  283         }
  284 
  285         # WRITE
  286         if (@{$ready[1]}) {
  287             my $fh = $ready[1][0];
  288             $debug && print "stdin is ready for input...\n";
  289             $input_line = shift(@input)."\n";
  290             $debug && print "INPUT: [$input_line]\n";
  291             $ret = syswrite($write_fh, $input_line);
  292             defined($ret) || die "write failed: $!\n";
  293             $debug && print "wrote [$ret] bytes\n";
  294             if (!@input) {
  295                 $debug && print "input exhausted. closing\n";
  296                 $sel_w->remove($write_fh);
  297                 $write_fh->close;
  298             }
  299         }
  300     }
  301 
  302     $debug && print "waitpid returned status [$child_status]\n";
  303 
  304     if ($reset_uid) {
  305         $EUID = $old_euid;
  306         $EGID = $old_egid;
  307     }
  308 
  309     return ($child_status/256, $result{out}, $result{err});
  310 }
  311 
  312 sub convertString
  313 {
  314     my $str = shift;
  315 
  316     my $copy = $str;
  317     my $decoded;
  318     eval {
  319         $decoded = decode('utf8', $copy, 1);
  320     };
  321     if ($@) {
  322         # decode failed. assume iso-8859-1
  323         $decoded = decode('iso-8859-1', $str);
  324     }
  325 
  326     return encode('utf8', $decoded);
  327 }
  328 
  329 1;