Commit 4791af1f authored by Xavier Guimard's avatar Xavier Guimard

Import original source of Apache-Session-SQLite3 0.09

parents
[Changes for 0.03 - 2005-02-02]
* Fixed clobbering of $_ and $@ during ->store calls.
* First version under svk management.
Changes
inc/Module/Install.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
inc/Module/Install/Fetch.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/Apache/Session/SQLite3.pm
lib/Apache/Session/Store/SQLite3.pm
Makefile.PL
MANIFEST This list of files
META.yml
README
SIGNATURE
t/1-basic.t
name: Apache-Session-SQLite3
version: 0.03
abstract: Use DBD::SQLite 1.x for Apache::Session storage
author: Autrijus Tang <autrijus@autrijus.org>
license: perl
distribution_type: module
requires:
DBD::SQLite: 1.00
Apache::Session: 0.15
no_index:
directory:
- inc
generated_by: Module::Install version 0.36
#!/usr/local/bin/perl
use inc::Module::Install;
name ('Apache-Session-SQLite3');
author ('Autrijus Tang <autrijus@autrijus.org>');
abstract ('Use DBD::SQLite 1.x for Apache::Session storage');
license ('perl');
version_from('lib/Apache/Session/SQLite3.pm');
requires (qw(
DBD::SQLite 1.00
Apache::Session 0.15
));
WriteAll ( sign => 1 );
This is the README file for Apache::Session::SQLite3, an Apache::Session
subclass using DBD::SQLite 1.x.
Please type "perldoc Apache::Session::SQLite3" after installation to see
the module usage information.
* Installation
Apache::Session::SQLite3 uses the standard perl module install process:
cpansign -v # optional; see SIGNATURE for details
perl Makefile.PL
make # or 'nmake' on Win32
make test
make install
* Copyright
Copyright 2004, 2005 by Autrijus Tang <autrijus@autrijus.org>.
All rights reserved. You can redistribute and/or modify
this bundle under the same terms as Perl itself.
See <http://www.perl.com/perl/misc/Artistic.html>.
This file contains message digests of all files listed in MANIFEST,
signed via the Module::Signature module, version 0.44.
To verify the content in this distribution, first make sure you have
Module::Signature installed, then type:
% cpansign -v
It will check each file's integrity, as well as the signature's
validity. If "==> Signature verified OK! <==" is not displayed,
the distribution may already have been compromised, and you should
not run its Makefile.PL or Build.PL.
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
SHA1 7d06199eb13a9cb916722a3d7e96334c26a79185 Changes
SHA1 b48bff4ee1d73db253c2eb73749a4e2daddfc944 MANIFEST
SHA1 4faf77381c483cc19900be7db592bcb97a706c67 META.yml
SHA1 1e28aad8580dd64a2ebd4e7f07515353a9c71880 Makefile.PL
SHA1 de8d083e1b78301598ca1cf3ac1525ae1a926c02 README
SHA1 06d883487127fa0026311904e7c4867e850c505c inc/Module/Install.pm
SHA1 2771d5c5033e94c4789c66a0aad4e21c62985ce9 inc/Module/Install/Base.pm
SHA1 b5e2d5fc07b92d042c97631d2b00f61f974fc164 inc/Module/Install/Can.pm
SHA1 c3747aa4bd8faa530c974b78f729c67f15c6f928 inc/Module/Install/Fetch.pm
SHA1 d8bc0d6e0a82d2b7533bdd3de467593094cc8b2c inc/Module/Install/Makefile.pm
SHA1 6fca1d05c6b9a8f10865de5be4fefb9bfa7a52e9 inc/Module/Install/Metadata.pm
SHA1 6b051a6d3ed824df40343a7ff09b66282e1783c3 inc/Module/Install/Win32.pm
SHA1 77f82ce7c623e05304ac9aae05bcd1a5558fadbb inc/Module/Install/WriteAll.pm
SHA1 0a55bae41ed08b4bdac7f6c35694308c7045256e lib/Apache/Session/SQLite3.pm
SHA1 4cc80f00485821e7d665c3d09eb573fcc7c34361 lib/Apache/Session/Store/SQLite3.pm
SHA1 6049b763901c2600adc57b55ded9e1d6ad3686d1 t/1-basic.t
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.2.6 (FreeBSD)
iD8DBQFCAKITtLPdNzw1AaARAuFZAKCfOu4NkW9Ny2eOTQyw/b2wKfxZLACdHRdK
z+qDX5lvxbJITfjjE7K3Onw=
=xCJK
-----END PGP SIGNATURE-----
#line 1 "inc/Module/Install.pm - /usr/local/lib/perl5/site_perl/5.8.5/Module/Install.pm"
package Module::Install;
$VERSION = '0.36';
die << "." unless $INC{join('/', inc => split(/::/, __PACKAGE__)).'.pm'};
Please invoke ${\__PACKAGE__} with:
use inc::${\__PACKAGE__};
not:
use ${\__PACKAGE__};
.
use strict 'vars';
use Cwd ();
use File::Find ();
use File::Path ();
@inc::Module::Install::ISA = 'Module::Install';
*inc::Module::Install::VERSION = *VERSION;
#line 129
sub import {
my $class = shift;
my $self = $class->new(@_);
if (not -f $self->{file}) {
require "$self->{path}/$self->{dispatch}.pm";
File::Path::mkpath("$self->{prefix}/$self->{author}");
$self->{admin} =
"$self->{name}::$self->{dispatch}"->new(_top => $self);
$self->{admin}->init;
@_ = ($class, _self => $self);
goto &{"$self->{name}::import"};
}
*{caller(0) . "::AUTOLOAD"} = $self->autoload;
# Unregister loader and worker packages so subdirs can use them again
delete $INC{"$self->{file}"};
delete $INC{"$self->{path}.pm"};
}
#line 156
sub autoload {
my $self = shift;
my $caller = caller;
my $cwd = Cwd::cwd();
my $sym = "$caller\::AUTOLOAD";
$sym->{$cwd} = sub {
my $pwd = Cwd::cwd();
if (my $code = $sym->{$pwd}) {
goto &$code unless $cwd eq $pwd; # delegate back to parent dirs
}
$$sym =~ /([^:]+)$/ or die "Cannot autoload $caller";
unshift @_, ($self, $1);
goto &{$self->can('call')} unless uc($1) eq $1;
};
}
#line 181
sub new {
my ($class, %args) = @_;
return $args{_self} if $args{_self};
$args{dispatch} ||= 'Admin';
$args{prefix} ||= 'inc';
$args{author} ||= '.author';
$args{bundle} ||= 'inc/BUNDLES';
$class =~ s/^\Q$args{prefix}\E:://;
$args{name} ||= $class;
$args{version} ||= $class->VERSION;
unless ($args{path}) {
$args{path} = $args{name};
$args{path} =~ s!::!/!g;
}
$args{file} ||= "$args{prefix}/$args{path}.pm";
bless(\%args, $class);
}
#line 210
sub call {
my $self = shift;
my $method = shift;
my $obj = $self->load($method) or return;
unshift @_, $obj;
goto &{$obj->can($method)};
}
#line 225
sub load {
my ($self, $method) = @_;
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
) unless $self->{extensions};
foreach my $obj (@{$self->{extensions}}) {
return $obj if $obj->can($method);
}
my $admin = $self->{admin} or die << "END";
The '$method' method does not exist in the '$self->{prefix}' path!
Please remove the '$self->{prefix}' directory and run $0 again to load it.
END
my $obj = $admin->load($method, 1);
push @{$self->{extensions}}, $obj;
$obj;
}
#line 255
sub load_extensions {
my ($self, $path, $top_obj) = @_;
unshift @INC, $self->{prefix}
unless grep { $_ eq $self->{prefix} } @INC;
local @INC = ($path, @INC);
foreach my $rv ($self->find_extensions($path)) {
my ($file, $pkg) = @{$rv};
next if $self->{pathnames}{$pkg};
eval { require $file; 1 } or (warn($@), next);
$self->{pathnames}{$pkg} = delete $INC{$file};
push @{$self->{extensions}}, $pkg->new( _top => $top_obj );
}
}
#line 279
sub find_extensions {
my ($self, $path) = @_;
my @found;
File::Find::find(sub {
my $file = $File::Find::name;
return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
return if $1 eq $self->{dispatch};
$file = "$self->{path}/$1.pm";
my $pkg = "$self->{name}::$1"; $pkg =~ s!/!::!g;
push @found, [$file, $pkg];
}, $path) if -d $path;
@found;
}
1;
__END__
#line 617
#line 1 "inc/Module/Install/Base.pm - /usr/local/lib/perl5/site_perl/5.8.5/Module/Install/Base.pm"
package Module::Install::Base;
#line 28
sub new {
my ($class, %args) = @_;
foreach my $method (qw(call load)) {
*{"$class\::$method"} = sub {
+shift->_top->$method(@_);
} unless defined &{"$class\::$method"};
}
bless(\%args, $class);
}
#line 46
sub AUTOLOAD {
my $self = shift;
goto &{$self->_top->autoload};
}
#line 57
sub _top { $_[0]->{_top} }
#line 68
sub admin {
my $self = shift;
$self->_top->{admin} or Module::Install::Base::FakeAdmin->new;
}
sub is_admin {
my $self = shift;
$self->admin->VERSION;
}
sub DESTROY {}
package Module::Install::Base::FakeAdmin;
my $Fake;
sub new { $Fake ||= bless(\@_, $_[0]) }
sub AUTOLOAD {}
sub DESTROY {}
1;
__END__
#line 112
#line 1 "inc/Module/Install/Can.pm - /usr/local/lib/perl5/site_perl/5.8.5/Module/Install/Can.pm"
package Module::Install::Can;
use Module::Install::Base; @ISA = qw(Module::Install::Base);
$VERSION = '0.01';
use strict;
use Config ();
use File::Spec ();
use ExtUtils::MakeMaker ();
# check if we can run some command
sub can_run {
my ($self, $cmd) = @_;
my $_cmd = $cmd;
return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
my $abs = File::Spec->catfile($dir, $_[1]);
return $abs if (-x $abs or $abs = MM->maybe_command($abs));
}
return;
}
sub can_cc {
my $self = shift;
my @chunks = split(/ /, $Config::Config{cc}) or return;
# $Config{cc} may contain args; try to find out the program part
while (@chunks) {
return $self->can_run("@chunks") || (pop(@chunks), next);
}
return;
}
1;
#line 1 "inc/Module/Install/Fetch.pm - /usr/local/lib/perl5/site_perl/5.8.5/Module/Install/Fetch.pm"
package Module::Install::Fetch;
use Module::Install::Base; @ISA = qw(Module::Install::Base);
$VERSION = '0.01';
sub get_file {
my ($self, %args) = @_;
my ($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
if ($scheme eq 'http' and !eval { require LWP::Simple; 1 }) {
$args{url} = $args{ftp_url}
or (warn("LWP support unavailable!\n"), return);
($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
}
$|++;
print "Fetching '$file' from $host... ";
unless (eval { require Socket; Socket::inet_aton($host) }) {
warn "'$host' resolve failed!\n";
return;
}
return unless $scheme eq 'ftp' or $scheme eq 'http';
require Cwd;
my $dir = Cwd::getcwd();
chdir $args{local_dir} or return if exists $args{local_dir};
if (eval { require LWP::Simple; 1 }) {
LWP::Simple::mirror($args{url}, $file);
}
elsif (eval { require Net::FTP; 1 }) { eval {
# use Net::FTP to get past firewall
my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
$ftp->login("anonymous", 'anonymous@example.com');
$ftp->cwd($path);
$ftp->binary;
$ftp->get($file) or (warn("$!\n"), return);
$ftp->quit;
} }
elsif (my $ftp = $self->can_run('ftp')) { eval {
# no Net::FTP, fallback to ftp.exe
require FileHandle;
my $fh = FileHandle->new;
local $SIG{CHLD} = 'IGNORE';
unless ($fh->open("|$ftp -n")) {
warn "Couldn't open ftp: $!\n";
chdir $dir; return;
}
my @dialog = split(/\n/, << ".");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
.
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
}
unless (-f $file) {
warn "Fetching failed: $@\n";
chdir $dir; return;
}
return if exists $args{size} and -s $file != $args{size};
system($args{run}) if exists $args{run};
unlink($file) if $args{remove};
print(((!exists $args{check_for} or -e $args{check_for})
? "done!" : "failed! ($!)"), "\n");
chdir $dir; return !$?;
}
1;
#line 1 "inc/Module/Install/Makefile.pm - /usr/local/lib/perl5/site_perl/5.8.5/Module/Install/Makefile.pm"
package Module::Install::Makefile;
use Module::Install::Base; @ISA = qw(Module::Install::Base);
$VERSION = '0.01';
use strict 'vars';
use vars '$VERSION';
use ExtUtils::MakeMaker ();
sub Makefile { $_[0] }
sub prompt {
shift;
goto &ExtUtils::MakeMaker::prompt;
}
sub makemaker_args {
my $self = shift;
my $args = ($self->{makemaker_args} ||= {});
%$args = ( %$args, @_ ) if @_;
$args;
}
sub clean_files {
my $self = shift;
my $clean = $self->makemaker_args->{clean} ||= {};
%$clean = (
%$clean,
FILES => join(" ", grep length, $clean->{FILES}, @_),
);
}
sub libs {
my $self = shift;
my $libs = ref $_[0] ? shift : [shift];
$self->makemaker_args( LIBS => $libs );
}
sub inc {
my $self = shift;
$self->makemaker_args( INC => shift );
}
sub write {
my $self = shift;
die "&Makefile->write() takes no arguments\n" if @_;
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args);
$args->{VERSION} = $self->version || $self->determine_VERSION($args);
$args->{NAME} =~ s/-/::/g;
if ($] >= 5.005) {
$args->{ABSTRACT} = $self->abstract;
$args->{AUTHOR} = $self->author;
}
if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
$args->{NO_META} = 1;
}
if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 ) {
$args->{SIGN} = 1 if $self->sign;
}
delete $args->{SIGN} unless $self->is_admin;
# merge both kinds of requires into prereq_pm
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_,
($self->build_requires, $self->requires) );
# merge both kinds of requires into prereq_pm
my $dir = ($args->{DIR} ||= []);
if ($self->bundles) {
push @$dir, map "$_->[1]", @{$self->bundles};
delete $prereq->{$_->[0]} for @{$self->bundles};
}
if (my $perl_version = $self->perl_version) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, ".
"but we need version >= $perl_version";
}
my %args = map {($_ => $args->{$_})} grep {defined($args->{$_})} keys %$args;
if ($self->admin->preop) {
$args{dist} = $self->admin->preop;
}
ExtUtils::MakeMaker::WriteMakefile(%args);
$self->fix_up_makefile();
}
sub fix_up_makefile {
my $self = shift;
my $top_class = ref($self->_top) || '';
my $top_version = $self->_top->VERSION || '';
my $preamble = $self->preamble
? "# Preamble by $top_class $top_version\n" . $self->preamble
: '';
my $postamble = "# Postamble by $top_class $top_version\n" .
($self->postamble || '');
open MAKEFILE, '< Makefile' or die $!;
my $makefile = do { local $/; <MAKEFILE> };
close MAKEFILE;
$makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
$makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
$makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
$makefile =~ s/^(FULLPERL = .*)/$1 -Iinc/m;
$makefile =~ s/^(PERL = .*)/$1 -Iinc/m;
open MAKEFILE, '> Makefile' or die $!;
print MAKEFILE "$preamble$makefile$postamble";
close MAKEFILE;
}
sub preamble {
my ($self, $text) = @_;
$self->{preamble} = $text . $self->{preamble} if defined $text;
$self->{preamble};
}
sub postamble {
my ($self, $text) = @_;
$self->{postamble} ||= $self->admin->postamble;
$self->{postamble} .= $text if defined $text;
$self->{postamble}
}
1;
__END__
#line 273
#line 1 "inc/Module/Install/Metadata.pm - /usr/local/lib/perl5/site_perl/5.8.5/Module/Install/Metadata.pm"
package Module::Install::Metadata;
use Module::Install::Base; @ISA = qw(Module::Install::Base);
$VERSION = '0.04';
use strict 'vars';
use vars qw($VERSION);
sub Meta { shift }
my @scalar_keys = qw(
name module_name version abstract author license
distribution_type sign perl_version
);
my @tuple_keys = qw(build_requires requires recommends bundles);
foreach my $key (@scalar_keys) {
*$key = sub {
my $self = shift;
return $self->{'values'}{$key} unless @_;
$self->{'values'}{$key} = shift;
return $self;
};
}
foreach my $key (@tuple_keys) {
*$key = sub {
my $self = shift;
return $self->{'values'}{$key} unless @_;
my @rv;
while (@_) {
my $module = shift or last;
my $version = shift || 0;
if ($module eq 'perl') {
$version =~ s{^(\d+)\.(\d+)\.(\d+)}
{$1 + $2/1_000 + $3/1_000_000}e;
$self->perl_version($version);
next;
}
my $rv = [$module, $version];
push @{$self->{'values'}{$key}}, $rv;
push @rv, $rv;
}
return @rv;
};
}
sub features {
my $self = shift;
while (my ($name, $mods) = splice(@_, 0, 2)) {
my $count = 0;
push @{$self->{'values'}{'features'}}, ($name => [
map { (++$count % 2 and ref($_) and ($count += $#$_)) ? @$_ : $_ } @$mods
] );
}
return @{$self->{'values'}{'features'}};
}
sub no_index {
my $self = shift;
my $type = shift;
push @{$self->{'values'}{'no_index'}{$type}}, @_ if $type;
return $self->{'values'}{'no_index'};
}
sub _dump {
my $self = shift;
my $package = ref($self->_top);
my $version = $self->_top->VERSION;
my %values = %{$self->{'values'}};
delete $values{sign};
if (my $perl_version = delete $values{perl_version}) {
# Always canonical to three-dot version
$perl_version =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2), int($3))}e
if $perl_version >= 5.006;
$values{requires} = [
[perl => $perl_version],
@{$values{requires}||[]},
];
}
warn "No license specified, setting license = 'unknown'\n"
unless $values{license};
$values{license} ||= 'unknown';
$values{distribution_type} ||= 'module';
$values{name} ||= do {
my $name = $values{module_name};
$name =~ s/::/-/g;
$name;
} if $values{module_name};
if ($values{name} =~ /::/) {
my $name = $values{name};
$name =~ s/::/-/g;
die "Error in name(): '$values{name}' should be '$name'!\n";
}
my $dump = '';
foreach my $key (@scalar_keys) {
$dump .= "$key: $values{$key}\n" if exists $values{$key};
}
foreach my $key (@tuple_keys) {
next unless exists $values{$key};
$dump .= "$key:\n";
foreach (@{$values{$key}}) {
$dump .= " $_->[0]: $_->[1]\n";
}
}
if (my $no_index = $values{no_index}) {
push @{$no_index->{'directory'}}, 'inc';
require YAML;
local $YAML::UseHeader = 0;
$dump .= YAML::Dump({ no_index => $no_index});
}
else {
$dump .= << "META";
no_index:
directory:
- inc
META