view release on metacpan or  search on metacpan

Traffic.pm  view on Meta::CPAN

    }
  }
  (defined $uid) or ($uid = '-');
  unless (defined $SEMID) {
    unless (defined($SEMID = semget(SEMKEY, 1, MODE | IPC_CREAT))) {
      error("unable to obtain semaphore for locking: $!");
      return DECLINED;
    }
  }
  unless (semop($SEMID, pack "s*", 0, 0, 0, 0, 1, SEM_UNDO)) {
    error("unable to obtain lock: $!");
    return DECLINED;
  }
  unless (defined $KNOT) { # THE TIE IS PERSISTENT
    unless ($KNOT = tie(%STATS, 'IPC::Shareable', SHMKEY, 
                        { create => 1, mode => MODE })) {
      error("unable to tie to shared memory: $!");
      return DECLINED;
    }
  }
  if (time >= $TOMORROW) { 
    $TODAY = timegm(0, 0, 0, (localtime)[3..5]); # START OF TODAY
    $TOMORROW = $TODAY + ONEDAY;
    # SEE THE "Thingy Referenced Is Initially True" SECTION OF
    # IPC::Shareable.  WE DO THIS TO MINIMIZE THE NUMBER OF SHARED
    # MEMORY SEGMENTS USED. 
    unless (exists $STATS{$TODAY}) {
      $STATS{$TODAY} = { $uid => { hits => 0, bytes => 0 }};
    } 
    # MOVE DATA FROM SHARED MEMORY INTO DBM FILE IF > 1 DAY INFO
    if ((keys %STATS > 1) and (USE_DBM)) { 
      unless (_move_shm_to_dbm($r)) {
        unless (semop($SEMID, pack "s*", 0, -1, SEM_UNDO)) {
          error("unable to release lock: $!");
        }
        return DECLINED;
      }
    }
  }
  $ref = $STATS{$TODAY};
  $$ref{$uid}{hits} += 1;
  $$ref{$uid}{bytes} += $bytes;
  $STATS{$TODAY} = $ref;
  unless (semop($SEMID, pack "s*", 0, -1, SEM_UNDO)) {
    error("unable to release lock: $!");
    return DECLINED;
  }
  OK; 
}

sub handler { shift->post_connection(\&logger) }

1;

__END__

sub error {
  my($error, $package, $line, $r);

  if (@_) {
    ($package, $line) = (caller)[0,2];
    $ERRMSG = join('', "$package [$line]: ", @_);
    eval { $r = Apache->request };
    unless ($@) {
      $r->log_error($ERRMSG);
    }
    return undef;
  } else {
    return $ERRMSG;
  }
}

sub fetch {
  my($start, $end, $wantuid, $all, @users) = @_;
  my(%hash, %uids, $uid, $db_obj, %db, $ref);

  $start = timegm(0, 0, 0, (localtime($start))[3..5]); # START OF DAY
  $end   = timegm(0, 0, 0, (localtime($end))[3..5]);
  tie(%STATS, 'IPC::Shareable', SHMKEY, { create => 'no' })
    or return error("unable to tie to shared memory: $!");
  if (-e DBPATH) { # DBM FILE WON'T EXIST UNTIL HANDLER HAS RUN FOR > 1 DAY
    $db_obj = tie %db, 'DB_File', DBPATH, O_RDONLY, MODE
      or return error("unable to open dbm file: $!");
  }
  @users = () if ($all);
  foreach(@users) {
    # LOOKUP THE USERNAME IF WE WERE PASSED A UID
    $_ = (getpwuid $_)[0] || $_ if ($_ =~ /^\d+$/);
    # LOOKUP THE UID
    (defined($uid = (getpwnam $_)[2])) || ($uid = $_);
    # STORE THE USERNAME INDEXED BY UID (unless $wantuid is true)
    $uids{$uid} = ($wantuid ? $uid : $_);
  }
  while($start <= $end) {
    unless ($all) {
      foreach(keys %uids) { # MAKE SURE WE RETURN VALUES FOR EVERY USER
        $hash{$start}{ $uids{$_} } = { bytes => 0, hits => 0 };
      }
    }
    if (exists $STATS{$start}) {
      $ref = $STATS{$start};
    } elsif ((defined $db_obj) and (exists $db{$start})) {
      $ref = thaw($db{$start});
    } else {
      $start += ONEDAY;
      next;
    }
    if ($all) {
      foreach(keys %$ref) {
        unless (defined $uids{$_}) {
          $uids{$_} = $_;
          if ((/^\d+$/) and (! $wantuid)) {
            $uids{$_} = (getpwuid $_)[0] || $_;
          }
        }
      }
    } 
    foreach(keys %uids) {
      next unless (exists $ref->{$_});
      $hash{$start}{ $uids{$_} }{bytes} = $ref->{$_}{bytes};
      $hash{$start}{ $uids{$_} }{hits}  = $ref->{$_}{hits};