IO-All-LWP-0.14/0000755000175000017500000000000010602665734012520 5ustar tuberttubertIO-All-LWP-0.14/inc/0000755000175000017500000000000010602665734013271 5ustar tuberttubertIO-All-LWP-0.14/inc/Module/0000755000175000017500000000000010602665734014516 5ustar tuberttubertIO-All-LWP-0.14/inc/Module/Install.pm0000644000175000017500000001761110602665623016465 0ustar tuberttubert#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.004; use strict 'vars'; use vars qw{$VERSION}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '0.65'; } # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE"; Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE } # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 and (stat($0))[9] > time ) { die << "END_DIE"; Your installer $0 has a modification time in the future. This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } use Cwd (); use File::Find (); use File::Path (); use FindBin; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; unshift @_, ($self, $1); goto &{$self->can('call')} unless uc($1) eq $1; }; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; unless ( -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"}; } *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; } sub preload { my ($self) = @_; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { my $admin = $self->{admin}; @exts = $admin->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $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{base}/$args{prefix}/$args{path}.pm"; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } 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_DIE"; 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_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = delete $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } 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; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!"; my $in_pod = 0; while ( ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } close PKGFILE; } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } 1; IO-All-LWP-0.14/inc/Module/Install/0000755000175000017500000000000010602665734016124 5ustar tuberttubertIO-All-LWP-0.14/inc/Module/Install/Fetch.pm0000644000175000017500000000463010602665623017513 0ustar tuberttubert#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.65'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } 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/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP 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; IO-All-LWP-0.14/inc/Module/Install/Makefile.pm0000644000175000017500000001355210602665623020202 0ustar tuberttubert#line 1 package Module::Install::Makefile; use strict 'vars'; use Module::Install::Base; use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.65'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing, always use defaults if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } sub makemaker_args { my $self = shift; my $args = ($self->{makemaker_args} ||= {}); %$args = ( %$args, @_ ) if @_; $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{name} = defined $args->{$name} ? join( ' ', $args->{name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join(' ', grep length, $clean->{FILES}, @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join(' ', grep length, $realclean->{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 ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } 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 and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } # 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 $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { foreach my $bundle (@{ $self->bundles }) { my ($file, $dir) = @$bundle; push @$subdirs, $dir if -d $dir; delete $prereq->{$file}; } } 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"; } $args->{INSTALLDIRS} = $self->installdirs; my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if (my $preop = $self->admin->preop($user_preop)) { $args{dist} = $preop; } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = 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 || ''); local *MAKEFILE; open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $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; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/("?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } 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 338 IO-All-LWP-0.14/inc/Module/Install/Base.pm0000644000175000017500000000203510602665623017331 0ustar tuberttubert#line 1 package Module::Install::Base; $VERSION = '0.65'; # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } ### This is the ONLY module that shouldn't have strict on # use strict; #line 41 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 61 sub AUTOLOAD { my $self = shift; local $@; my $autoload = eval { $self->_top->autoload } or return; goto &$autoload; } #line 76 sub _top { $_[0]->{_top} } #line 89 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } sub is_admin { $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $Fake; sub new { $Fake ||= bless(\@_, $_[0]) } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 138 IO-All-LWP-0.14/inc/Module/Install/Metadata.pm0000644000175000017500000002021510602665623020177 0ustar tuberttubert#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.65'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } my @scalar_keys = qw{ name module_name abstract author version license distribution_type perl_version tests installdirs }; my @tuple_keys = qw{ build_requires requires recommends bundles }; sub Meta { shift } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } foreach my $key (@scalar_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} if defined wantarray and !@_; $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 @rv, $rv; } push @{ $self->{values}{$key} }, @rv; @rv; }; } sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub sign { my $self = shift; return $self->{'values'}{'sign'} if defined wantarray and !@_; $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 ); return $self; } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n"; return $self; } $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0; return $self; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die "all_from called with no args without setting name() first"; $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; die "all_from: cannot find $file from $name" unless -e $file; } $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; # The remaining probes read from POD sections; if the file # has an accompanying .pod, use that instead my $pod = $file; if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) { $file = $pod; } $self->author_from($file) unless $self->author; $self->license_from($file) unless $self->license; $self->abstract_from($file) unless $self->abstract; } sub provides { my $self = shift; my $provides = ( $self->{values}{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides(%{ $build->find_dist_packages || {} }); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $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 read { my $self = shift; $self->include_deps( 'YAML', 0 ); require YAML; my $data = YAML::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } sub _slurp { my ( $self, $file ) = @_; local *FH; open FH, "< $file" or die "Cannot open $file.pod: $!"; do { local $/; }; } sub perl_version_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ ^ use \s* v? ([\d_\.]+) \s* ; /ixms ) { my $v = $1; $v =~ s{_}{}g; $self->perl_version($1); } else { warn "Cannot determine perl version info from $file\n"; return; } } sub author_from { my ( $self, $file ) = @_; my $content = $self->_slurp($file); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; $author =~ s{E}{<}g; $author =~ s{E}{>}g; $self->author($author); } else { warn "Cannot determine author info from $file\n"; } } sub license_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ ( =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b .*? ) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as perl itself' => 'perl', 'GNU public license' => 'gpl', 'GNU lesser public license' => 'gpl', 'BSD license' => 'bsd', 'Artistic license' => 'artistic', 'GPL' => 'gpl', 'LGPL' => 'lgpl', 'BSD' => 'bsd', 'Artistic' => 'artistic', 'MIT' => 'MIT', ); while ( my ( $pattern, $license ) = splice( @phrases, 0, 2 ) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { $self->license($license); return 1; } } } warn "Cannot determine license info from $file\n"; return 'unknown'; } 1; IO-All-LWP-0.14/inc/Module/Install/Can.pm0000644000175000017500000000337410602665623017167 0ustar tuberttubert#line 1 package Module::Install::Can; use strict; use Module::Install::Base; use Config (); ### This adds a 5.005 Perl version dependency. ### This is a bug and will be fixed. use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.65'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # 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; } # can we locate a (the) C compiler 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; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 157 IO-All-LWP-0.14/inc/Module/Install/WriteAll.pm0000644000175000017500000000162410602665623020205 0ustar tuberttubert#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.65'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_ ); $self->sign(1) if $args{sign}; $self->Meta->write if $args{meta}; $self->admin->WriteAll(%args) if $self->is_admin; if ( $0 =~ /Build.PL$/i ) { $self->Build->write; } else { $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{'PL_FILES'} ) { $self->makemaker_args( PL_FILES => {} ); } if ($args{inline}) { $self->Inline->write; } else { $self->Makefile->write; } } } 1; IO-All-LWP-0.14/inc/Module/Install/Win32.pm0000644000175000017500000000341610602665623017365 0ustar tuberttubert#line 1 package Module::Install::Win32; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.65'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); if (!$rv) { die <<'END_MESSAGE'; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } } 1; IO-All-LWP-0.14/Changes0000644000175000017500000000074510602665600014011 0ustar tuberttubertRevision history for IO-All-LWP 0.14 2007-03-29 - Fixed an "Oops" in yesterday's release (0.13), which passed the compilation tests but didn't actually work. 0.13 2007-03-28 - Updated for new version of IO::All. Thanks to MAREKR for sending a patch! 0.12 2004-11-02 - Added IO::All::LWP module. Thanks Richard Soderberg! 0.11 2004-10-1 - Added ua method. - Fixed error in the docs. 0.10 2004-07-20 - First release IO-All-LWP-0.14/lib/0000755000175000017500000000000010602665734013266 5ustar tuberttubertIO-All-LWP-0.14/lib/IO/0000755000175000017500000000000010602665734013575 5ustar tuberttubertIO-All-LWP-0.14/lib/IO/All/0000755000175000017500000000000010602665734014305 5ustar tuberttubertIO-All-LWP-0.14/lib/IO/All/FTP.pm0000644000175000017500000000317110602665471015274 0ustar tuberttubertpackage IO::All::FTP; use strict; use warnings; our $VERSION = '0.14'; use IO::All::LWP '-base'; const type => 'ftp'; sub ftp { my $self=shift; $self->lwp_init(__PACKAGE__, @_) } 1; __END__ =head1 NAME IO::All::FTP - Extends IO::All to FTP URLs =head1 SYNOPSIS use IO::All; "hello world\n" > io('ftp://localhost/test/x'); # save to FTP io('ftp//example.org/pub/xyz') > io('xyz'); # GET to file # two ways of getting a file with a password: $content < io('ftp://me:secret@example.org/xyz'); $content < io('ftp://example.org/xyz')->user('me')->password('secret'); =head1 DESCRIPTION This module extends IO::All for dealing with FTP URLs. Note that you don't need to use it explicitly, as it is autoloaded by L whenever it sees something that looks like an FTP URL. =head1 METHODS This is a subclass of L. The only new method is C, which can be used to create a blank L object; or it can also take an FTP URL as a parameter. Note that in most cases it is simpler just to call io('ftp//example.com'), which calls the C method automatically. =head1 OPERATOR OVERLOADING The same operators from IO::All may be used. < GETs an FTP URL; > PUTs to an FTP URL. =head1 SEE ALSO L, L, L. =head1 AUTHORS Ivan Tubert-Brohman and Brian Ingerson =head1 COPYRIGHT Copyright (c) 2007. Ivan Tubert-Brohman and Brian Ingerson. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut IO-All-LWP-0.14/lib/IO/All/HTTP.pm0000644000175000017500000000401610602665471015421 0ustar tuberttubertpackage IO::All::HTTP; use strict; use warnings; our $VERSION = '0.14'; use IO::All::LWP '-base'; use URI::http; use URI::_userpass; push @URI::http::ISA, 'URI::_userpass'; const type => 'http'; sub http { my $self=shift; $self->lwp_init(__PACKAGE__, @_) } 1; __END__ =head1 NAME IO::All::LWP - Extends IO::All to HTTP URLs =head1 SYNOPSIS use IO::All; $content < io('http://example.org'); # GET webpage into scalar io('http://example.org') > io('index.html'); # GET to file "hello\n" > io('http://example.org/index.html'); # PUT webpage # two ways of getting a page with a password: $content < io('http://me:secret@example.org'); $content < io('http://example.org')->user('me')->password('secret'); =head1 DESCRIPTION This module extends L for dealing with HTTP URLs. Note that you don't need to use it explicitly, as it is autoloaded by L whenever it sees something that looks like an HTTP URL. The SYNOPSIS shows some simple typical examples, but there are many other interesting combinations with other IO::All features! For example, you can get an HTTP URL and write the content to a socket, or to an FTP URL, of to a DBM file. =head1 METHODS This is a subclass of L. The only new method is C, which can be used to create a blank L object; or it can also take an HTTP URL as a parameter. Note that in most cases it is simpler just to call io('http://example.com'), which calls the C method automatically. =head1 OPERATOR OVERLOADING The same operators from IO::All may be used. < GETs an HTTP URL; > PUTs to an HTTP URL. =head1 SEE ALSO L, L, L. =head1 AUTHORS Ivan Tubert-Brohman and Brian Ingerson =head1 COPYRIGHT Copyright (c) 2007. Ivan Tubert-Brohman and Brian Ingerson. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut IO-All-LWP-0.14/lib/IO/All/HTTPS.pm0000644000175000017500000000347210602665471015551 0ustar tuberttubertpackage IO::All::HTTPS; use strict; use warnings; our $VERSION = '0.14'; use IO::All::HTTP '-base'; const type => 'https'; sub https { my $self=shift;$self->lwp_init(__PACKAGE__, @_) } 1; __END__ =head1 NAME IO::All::HTTPS - Extends IO::All for HTTPS URLs =head1 SYNOPSIS use IO::All; $content < io('https://example.org'); # GET webpage # two ways of getting a page with a password: $content < io('https://me:secret@example.org'); $content < io('https://example.org')->user('me')->password('secret'); =head1 DESCRIPTION This module extends L for dealing with HTTPS URLs. Note that you don't need to use it explicitly, as it is autoloaded by L whenever it sees something that looks like an HTTPS URL. The SYNOPSIS shows some simple typical examples, but there are many other interesting combinations with other IO::All features! For example, you can get an HTTPS URL and write the content to a socket, or to an FTP URL, of to a DBM file. =head1 METHODS This is a subclass of L. The only new method is C, which can be used to create a blank L object; or it can also take an HTTPS URL as a parameter. Note that in most cases it is simpler just to call io('https://example.com'), which calls the C method automatically. =head1 OPERATOR OVERLOADING The same operators from IO::All may be used. < GETs an HTTPS URL; > PUTs to an HTTPS URL. =head1 SEE ALSO L, L, L. =head1 AUTHORS Ivan Tubert-Brohman and Brian Ingerson =head1 COPYRIGHT Copyright (c) 2007. Ivan Tubert-Brohman and Brian Ingerson. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut IO-All-LWP-0.14/lib/IO/All/LWP.pm0000644000175000017500000001445210602665471015311 0ustar tuberttubertpackage IO::All::LWP; require 5.008; use strict; use warnings; our $VERSION = '0.14'; use IO::All 0.30 '-base'; use LWP::UserAgent; use IO::Handle; my $DEFAULT_UA = LWP::UserAgent->new(env_proxy => 1); field 'response'; field 'content'; field 'put_content'; sub lwp_init { my $self = shift; bless $self, shift; $self->name(shift) if @_; return $self->_init; } sub ua { my $self = shift; if (@_) { *$self->{ua} = ref($_[0]) ? shift : LWP::UserAgent->new(@_); return $self; } else { *$self->{ua} ||= $DEFAULT_UA; } } sub uri { my $self = shift; *$self->{uri} = ref($_[0]) ? shift : URI->new(shift) if @_; return *$self->{uri} if defined *$self->{uri}; *$self->{uri} = URI->new($self->name); } sub user { my $self = shift; $self->uri->user(@_); return $self; } sub password { my $self = shift; $self->uri->password(@_); return $self; } sub get { my $self = shift; my $request = shift || HTTP::Request->new('GET', $self->uri); $self->request($request); } sub put { my $self = shift; my $request = (@_ and ref $_[0]) ? $_[0] : do { my $content = @_ ? shift : $self->content; HTTP::Request->new(PUT => $self->uri, undef, $content); }; $self->request($request); $self->is_open(0); } sub request { my $self = shift; $self->response($self->ua->request(shift)); } sub open { my $self = shift; $self->is_open(1); my $mode = @_ ? shift : $self->mode ? $self->mode : '<'; $self->mode($mode); my $fh; if ($mode eq '<') { $self->content($self->get->content); CORE::open $fh, "<", \ $self->content; } elsif ($mode eq '>') { $self->put_content(\ do{ my $x = ''}); CORE::open $fh, ">", $self->put_content; } $self->io_handle($fh); return $self; } sub close { my $self = shift; if ($self->is_open and defined $self->mode and $self->mode eq '>') { $self->content(${$self->put_content}); $self->put; } $self->SUPER::close; } 1; __END__ =head1 NAME IO::All::LWP - IO::All interface to LWP =head1 SYNOPSIS use IO::All; "hello world\n" > io('ftp://localhost/test/x'); # save to FTP $content < io('http://example.org'); # GET webpage io('http://example.org') > io('index.html'); # save webpage =head1 DESCRIPTION This module acts as glue between L and L, so that files can be read and written through the network using the convenient L interface. Note that this module is not Cd directly: you just use L, which knows when to autoload L, L, L, or L, which implement the specific protocols based on L. =head1 EXECUTION MODEL B. When the IO::All object is opened, the URI is fetched and stored by the object in an internal file handle. It can then be accessed like any other file via the IO::All methods and operators, it can be tied, etc. B. When the IO::All object is opened, an internal file handle is created. It is possible to that file handle using the various IO::All methods and operators, it can be tied, etc. If $io->put is not called explicitly, when the IO::All object is closed, either explicitly via $io->close or automatically upon destruction, the actual PUT request is made. The bad news is that the whole file is stored in memory after getting it or before putting it. This may cause problems if you are dealing with multi-gigabyte files! =head1 METHODS The simplest way of doing things is via the overloaded operators > and <, as shown in the SYNOPSIS. These take care of automatically opening and closing the files and connections as needed. However, various methods are available to provide a finer degree of control. This is a subclass of L. In addition to the inherited methods, the following methods are available: =over =item * ua Set or get the user agent object (L or a subclass). If called with a list, the list is passed to LWP::UserAgent->new. If called with an object, the object is used directly as the user agent. Note that there is a default user agent if no user agent is specified. =item * uri Set or get the URI. It can take either a L object or a string, and it returns an L object. Note that calling this method overrides the user and password fields, because URIs can contain authentication information. =item * user Set or get the user name for authentication. Note that the user name (and the password) can also be set as part of the URL, as in "http://me:secret@example.com/". =item * password Set or get the password for authentication. Note that the password can also be set as part of the URL, as discussed above. =item * get GET the current URI using LWP. Or, if called with an L object as a parameter, it does that request instead. It returns the L object. =item * put PUT to the current URI using LWP. If called with an L object, it does that request instead. If called with a scalar, it PUTs that as the content to the current URI, instead of the current accumulated content. =item * response Return the L object. =item * request Does an LWP request. It requires an L object as a parameter. Returns an L object. =item * open Overrides the C method from L. It takes care of GETting the content, or of setting up the internal buffer for PUTting. Just like the C method from L, it can take a mode: '<' for GET and '>' for PUT. =item * close Overrides the C method from L. It takes care of PUTting the content. =back =head1 DEPENDENCIES This module uses L for all the heavy lifting. It also requires perl-5.8.0 or a more recent version. =head1 SEE ALSO L, L, L, L. =head1 AUTHORS Ivan Tubert-Brohman and Brian Ingerson Thanks to Sergey Gleizer for the ua method. =head1 COPYRIGHT Copyright (c) 2007. Ivan Tubert-Brohman and Brian Ingerson. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut IO-All-LWP-0.14/MANIFEST0000644000175000017500000000065510602471023013641 0ustar tuberttubertChanges 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 iocp.pl lib/IO/All/FTP.pm lib/IO/All/HTTP.pm lib/IO/All/HTTPS.pm lib/IO/All/LWP.pm Makefile.PL MANIFEST This list of files MANIFEST.bak META.yml README t/ftp.t t/http.t t/https.t t/lwp.t t/pod.t IO-All-LWP-0.14/iocp.pl0000755000175000017500000000027310602665266014014 0ustar tuberttubert#!/usr/bin/perl -w use strict; use warnings; use diagnostics; use blib; use IO::All; die "please give two URIs, filenames, or somethings\n" unless (@ARGV >= 2); io(shift) > io(shift); IO-All-LWP-0.14/t/0000755000175000017500000000000010602665734012763 5ustar tuberttubertIO-All-LWP-0.14/t/lwp.t0000644000175000017500000000006410602471022013733 0ustar tuberttubertuse Test::More tests => 1; use_ok('IO::All::LWP'); IO-All-LWP-0.14/t/http.t0000644000175000017500000000006510602471022014111 0ustar tuberttubertuse Test::More tests => 1; use_ok('IO::All::HTTP'); IO-All-LWP-0.14/t/pod.t0000644000175000017500000000040310602471022013710 0ustar tuberttubertuse Test::More; my @files = (glob("lib/*/*/*.pm")); eval 'use Test::Pod'; if ($@) { plan skip_all => "You don't have Test::Pod installed"; } else { plan tests => scalar @files; } for my $file (@files) { pod_file_ok($file, "POD for '$file'"); } IO-All-LWP-0.14/t/https.t0000644000175000017500000000006610602471022014275 0ustar tuberttubertuse Test::More tests => 1; use_ok('IO::All::HTTPS'); IO-All-LWP-0.14/t/ftp.t0000644000175000017500000000006410602471022013722 0ustar tuberttubertuse Test::More tests => 1; use_ok('IO::All::FTP'); IO-All-LWP-0.14/META.yml0000644000175000017500000000060710602665623013771 0ustar tuberttubert--- abstract: Use HTTP and FTP URLs with IO::All author: Ivan Tubert-Brohman distribution_type: module generated_by: Module::Install version 0.65 license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 name: IO-All-LWP no_index: directory: - inc - t requires: IO::All: 0.30 LWP: 0 perl: 5.8.0 version: 0.14 IO-All-LWP-0.14/MANIFEST.bak0000644000175000017500000000000010602474446014371 0ustar tuberttubertIO-All-LWP-0.14/README0000644000175000017500000000155410602665515013402 0ustar tuberttubertIO-All-LWP version 0.14 ======================= This module acts as glue between IO::All and LWP, so that files can be read and written through the network using the convenient IO:All interface. Note that this module is not "use"d directly: you just use IO::All, which knows when to autoload IO::All::HTTP, IO::All::HTTPS, IO::All::FTP, or IO::All::Gopher, which implement the specific protocols based on IO::All::LWP. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: perl 5.8.0 IO::All 0.30 LWP 0 COPYRIGHT AND LICENSE Copyright (C) 2007 Ivan Tubert-Brohman and Brian Ingerson This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. IO-All-LWP-0.14/Makefile.PL0000644000175000017500000000043310602471023014454 0ustar tuberttubertuse inc::Module::Install; name('IO-All-LWP'); author('Ivan Tubert-Brohman '); abstract('Use HTTP and FTP URLs with IO::All'); license('perl'); version_from('lib/IO/All/LWP.pm'); requires(qw( perl 5.8.0 IO::All 0.30 LWP 0 )); check_nmake(); &WriteAll();