Apache2::ClickPath::StoreClient - an Apache2::ClickPath::Store client

 use Apache2::ClickPath::StoreClient;

 my $store=Apache2::ClickPath::StoreClient->new;
 my $val=$store->get( 'val' );
 unless( $store->set( val=>$v ) ) {
   my $code=$store->lasterror;
   ...
 }

package Apache2::ClickPath::StoreClient;

use 5.008;
use strict;
use warnings;
no warnings qw(uninitialized);
use Storable ();
use LWP::UserAgent;
use LWP::ConnCache;
use Class::Member qw{session store store_is_local ua lasterror _r};

our $VERSION = '1.9';

my $MOD_PERL;

my $apache_ok;

BEGIN {
  $MOD_PERL=0;
  if( exists $ENV{MOD_PERL} and $ENV{MOD_PERL_API_VERSION}==2 ) {
    $MOD_PERL=2;
    require Apache2::RequestRec;
    require Apache2::RequestUtil;
    require Apache2::RequestIO;
    require Apache2::Filter;
    require Apache2::SubRequest;
    require APR::Brigade;
    require APR::Bucket;
    require Apache2::Const;
    Apache2::Const->import( -compile=>qw{OK} );
    $apache_ok=&Apache2::Const::OK;
  }
}

sub new {
  my $class=shift;
  my $I=bless {}=>ref($class)||$class;

  if( $MOD_PERL ) {
    $I->_r=Apache2::RequestUtil->request;
    $I->session=$I->_r->subprocess_env('SESSION');
    $I->store=$I->_r->subprocess_env('ClickPathMachineStore');

    $I->store_is_local=$I->store=~m!^/!;
  } else {
    $I->session=$ENV{SESSION};
    $I->store=$ENV{ClickPathMachineStore};
    if( $I->store=~m!^/! ) {
      my $https=($ENV{HTTPS}=~/on/i ? 'https' : 'http');
      if( length $ENV{HTTP_HOST} ) {
	my $host=$ENV{HTTP_HOST};
	$host=~s/:\d+$//;
	$I->store="$https://$host:$ENV{SERVER_PORT}".$I->store;
      } else {
	$I->store="$https://$ENV{SERVER_ADDR}:$ENV{SERVER_PORT}".$I->store;
      }
    }
  }

  return unless( length $I->store );

  unless( $I->store_is_local ) {
    $I->ua=LWP::UserAgent->new( timeout=>5,
				keep_alive=>3 );
  }

  return $I;
}

sub _get {
  my ($I,$k)=@_;

  if( $I->store_is_local ) {
    my $subr=$I->_r->lookup_uri( $I->store );
    $subr->pnotes( __PACKAGE__."::storeparams"=>{'a'=>'get',
						 's'=>$I->session,
						 'k'=>$k} );
    my $content;
    $subr->add_output_filter( sub {
				my ($f, $bb) = @_;
				while (my $e = $bb->first) {
				  $e->read(my $buf);
				  $content.=$buf;
				  $e->delete;
				}
				return $apache_ok;
			      });
    $I->lasterror=$subr->run;
    $I->lasterror=200 if( $I->lasterror==$apache_ok );
    return $content if( $I->lasterror==200 );
    return;
  } else {
    my $res=$I->ua->post( $I->store, {'a'=>'get',
				      's'=>$I->session,
				      'k'=>$k} );
    $I->lasterror=$res->code;
    return $res->content if( $res->code==200 );
    return;
  }
}

sub _set {
  my ($I,$k,$v)=@_;

  if( $I->store_is_local ) {
    my $subr=$I->_r->lookup_uri( $I->store );
    $subr->pnotes( __PACKAGE__."::storeparams"=>{'a'=>'set',
						 's'=>$I->session,
						 'k'=>$k,
						 'v'=>$v} );
    my $content;
    $subr->add_output_filter( sub {
				my ($f, $bb) = @_;
				while (my $e = $bb->first) {
				  $e->read(my $buf);
				  $content.=$buf;
				  $e->delete;
				}
				return $apache_ok;
			      });
    $I->lasterror=$subr->run;
    $I->lasterror=200 if( $I->lasterror==$apache_ok );
    return 1 if( $I->lasterror==200 );
    return;
  } else {
    my $res=$I->ua->post( $I->store, {'a'=>'set',
				      's'=>$I->session,
				      'k'=>$k,
				      'v'=>$v} );
    $I->lasterror=$res->code;
    return 1 if( $res->code==200 );
    return;
  }
}

sub get {
  my $I=shift;
  my $k=shift;

  my $res=Storable::thaw($I->_get( $k ))||[];
  if( wantarray ) {
    return @{$res};
  } else {
    return $res->[0];
  }
}

sub set {
  my $I=shift;
  my $k=shift;
  return $I->_set( $k, Storable::nfreeze( \@_ ) );
}

1;

__END__