"Fossies" - the Fresh Open Source Software Archive

Member "absence-v2.1/cgi-bin/old/AbsenceCurrent.pm" (21 Aug 2008, 1994 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 "AbsenceCurrent.pm" see the Fossies "Dox" file reference documentation.

    1 package AbsenceCurrent;
    2 
    3 use FileHandle;
    4 use Fcntl ':flock'; # import LOCK_* constants
    5 use Carp;
    6 
    7 use AbsenceConfig;
    8 use AbsenceLog;
    9 
   10 my $CURRENT_FILE    = AbsenceConfig::fetch('current_file');
   11 my %CURRENT;
   12 my $VERSION         = '1.1';
   13 
   14 _init();
   15 
   16 sub fetch
   17 {
   18     my $gid = shift;
   19 
   20     exists($CURRENT{$gid}) || return ();
   21 
   22     return @{$CURRENT{$gid}};
   23 }
   24 
   25 #------------------------------------------------------------
   26 # current month/day file routines
   27 #------------------------------------------------------------
   28 
   29 sub _init
   30 {
   31     my $fh = _open() || return;
   32     _read($fh);
   33     _close($fh);
   34 }
   35 
   36 sub _open
   37 {
   38     if (! -e $CURRENT_FILE) { return undef; }
   39     my $fh = FileHandle->new($CURRENT_FILE);
   40     defined($fh) || die "open on $CURRENT_FILE failed";
   41 
   42     $fh;
   43 }
   44 
   45 sub _close
   46 {
   47     my $fh = shift;
   48     $fh->close;
   49 }
   50 
   51 sub _read
   52 {
   53     my $fh = shift;
   54 
   55     my $line_num = 1;
   56     while(<$fh>) {
   57         chomp;
   58         next if /^\s*$/;
   59         next if /^\s*#/;
   60         my ($gid, $day, $month, $year) = (/^(\d+):(\d+)\.(\d+)\.(\d+)$/);
   61         #abslog("DBG: gid=$gid, day=$day, month=$month, year=$year");
   62         if (defined($gid)) {
   63             $CURRENT{$gid} = [$day, $month, $year];
   64         } else {
   65             abslog("cannot parse current at line $line_num [$_]");
   66         }
   67     } continue {
   68         $line_num++;
   69     }
   70 }
   71 
   72 sub update
   73 {
   74     my $gid = shift;
   75 
   76     # open for read and write
   77     my $openstr = (-e $CURRENT_FILE) ? "+<$CURRENT_FILE" : ">$CURRENT_FILE";
   78     my $fh = FileHandle->new($openstr);
   79     defined($fh) || confess "open on $CURRENT_FILE failed";
   80 
   81     # lock
   82     flock($fh, LOCK_EX) || die "flock lock_ex on $CURRENT_FILE ($!)";
   83 
   84     # re-read to be safe
   85     _read($fh);
   86 
   87     # update current group-ID in array
   88     my ($day, $month, $year) = (localtime)[3,4,5];
   89     $month++;
   90     $year += 1900;
   91     $CURRENT{$gid} = [$day, $month, $year];
   92 
   93     # seek to beginning
   94     seek($fh, 0, 0) || die "seek";
   95 
   96     # truncate ...
   97     truncate($fh, 0) || die "truncate";
   98 
   99     # ... and write 
  100     foreach my $gid (keys(%CURRENT)) {
  101         print $fh "$gid:", join('.', @{$CURRENT{$gid}}), "\n";
  102     }
  103 
  104     flock($fh, LOCK_UN) || die "flock lock_un on $CURRENT_FILE ($!)";
  105     $fh->close;
  106 }
  107 
  108 1;