view release on metacpan or  search on metacpan

lib/Apache/Scoreboard.pm  view on Meta::CPAN

package Apache::Scoreboard;

$Apache::Scoreboard::VERSION = '2.10';

use strict;
use warnings FATAL => 'all';

use Carp;

BEGIN {
    require mod_perl2;
    die "This module was built against mod_perl 2.0 ",
        "and can't be used with $mod_perl::VERSION, "
            unless $mod_perl::VERSION > 1.99;
}

# so that it can be loaded w/o mod_perl (.e.g MakeMaker requires this
# file when Apache::Scoreboard is some other module's PREREQ_PM)
if ($ENV{MOD_PERL}) {
    require XSLoader;
    XSLoader::load(__PACKAGE__, $Apache::Scoreboard::VERSION);
}
else {
    require Apache::DummyScoreboard;
}

use constant DEBUG => 0;

my $ua;

sub http_fetch {
    my($self, $url) = @_;

    Carp::croak("no url argument was passed") unless $url;

    require LWP::UserAgent;
    unless ($ua) {
	no strict 'vars';
	$ua = LWP::UserAgent->new;
	$ua->agent(join '/', __PACKAGE__, $VERSION);
    }

    my $request = HTTP::Request->new('GET', $url);
    my $response = $ua->request($request);
    die "failed to execute: 'GET $url', response: ",
        $response->status_line unless $response->is_success;

    # XXX: fixme
#    my $type = $response->header('Content-type');
#    unless ($type eq Apache::Scoreboard::REMOTE_SCOREBOARD_TYPE) {
#	warn "invalid scoreboard Content-type: $type" if DEBUG;
#	return undef;
#    }

    $response->content;
}

sub fetch {
    my($self, $pool, $url) = @_;
    $self->thaw($pool, $self->http_fetch($url));
}

sub fetch_store {
    my($self, $url, $file) = @_;
    $self->store($self->http_fetch($url), $file);
}

sub store {
    my($self, $frozen_image, $file) = @_;
    croak "undefined image passed" unless $frozen_image;
    open my $fh, ">$file" or die "open $file: $!";
    print $fh $frozen_image;
    close $fh;
}

sub retrieve {
    my($self, $pool, $file) = @_;
    open my $fh, $file or die "open $file: $!";
    local $/;
    my $data = <$fh>;
    close $fh;
    $self->thaw($pool, $data);
}

1;
__END__

=head1 NAME

Apache::Scoreboard - Perl interface to the Apache scoreboard structure





=head1 SYNOPSIS

 # Configuration in httpd.conf:
 # mod_status should be compiled in (it is by default)
 ExtendedStatus On

 # in your perl code:
  use Apache::Scoreboard ();