view release on metacpan or  search on metacpan

lib/Apache/Session/Counted.pm  view on Meta::CPAN

package Apache::Session::Counted;
use Apache::Session::Serialize::Storable;

use strict;
use vars qw(@ISA);
@ISA = qw(Apache::Session);
use vars qw($VERSION $RELEASE_DATE);
$VERSION = '1.119';
$RELEASE_DATE = q$Date: 2002/04/15 12:39:07 $;

use Apache::Session 1.50;
use File::CounterFile;

{
  package Apache::Session::CountedStore;
  use Symbol qw(gensym);

  use strict;

  sub new { bless {}, shift }

  # write. Note that we alias insert and update
  sub update {
    my $self    = shift;
    my $session = shift;
    my $storefile = $self->storefilename($session);
    my $fh = gensym;
    unless ( open $fh, ">$storefile\0" ) {
      warn qq{A:S:Counted: Could not open file $storefile for writing: $!
Maybe you haven't initialized the storage directory with
 use Apache::Session::Counted;
 Apache::Session::CountedStore->tree_init("$session->{args}{Directory}","$session->{args}{DirLevels}");
I'm trying to band-aid by creating this directory};
      require File::Basename;
      my $dir = File::Basename::dirname($storefile);
      require File::Path;
      File::Path::mkpath($dir);
      warn "A:S:Counted: mkdir on directory $dir successfully done.";
    }
    if ( open $fh, ">$storefile\0" ) {
      print $fh $session->{serialized}; # $fh->print might fail in some perls
      close $fh;
    } else {
      die "Giving up. Could not open file $storefile for writing: $!";
    }
  }
  *insert = \&update;

  # retrieve
  sub materialize {
    my $self    = shift;
    my $session = shift;
    my $sessionID = $session->{data}{_session_id} or die "Got no session ID";
    my($host) = $sessionID =~ /(?:([^:]+)(?::))/;
    my($content);

    if ($host &&
        $session->{args}{HostID} &&
        $session->{args}{HostID} ne $host
       ) {
      # warn sprintf("configured hostID[%s]host from argument[%s]",
      #              $session->{args}{HostID},
      #              $host);
      my $surl;
      if (exists $session->{args}{HostURL}) {
        $surl = $session->{args}{HostURL}->($host,$sessionID);
      } else {
        $surl = sprintf "http://%s/?SESSIONID=%s", $host, $sessionID;
      }
      # warn "surl[$surl]";
      if ($surl) {
        require LWP::UserAgent;
        require HTTP::Request::Common;
        my $ua = LWP::UserAgent->new;
        $ua->timeout($session->{args}{Timeout} || 10);
        my $req = HTTP::Request::Common::GET $surl;
        my $result = $ua->request($req);
        if ($result->is_success) {
          $content = $result->content;
        } else {
          $content = Storable::nfreeze {};
        }
      } else {