WWW-Mechanize-Shell-0.59/0000755000175000017500000000000013654075103014451 5ustar corioncorionWWW-Mechanize-Shell-0.59/MANIFEST.SKIP0000755000175000017500000000044513654075102016354 0ustar corioncorion\.lwpcookies$ \.cvsignore$ \.releaserc$ \.travis.yml$ \.prove cvstest ^\.git\/ maint ^tags$ .last_cover_stats .appveyor.yml ^\.github Makefile$ ^blib ^WWW-Mechanize-Shell- ^pm_to_blib ^.*.bak ^.*.old ^t.*sessions ^t/.*\.disabled$ ^cover_db ^.*\.log ^.*\.swp$ ^jar/ ^cpan/ ^MYMETA t/hook* CVS/ WWW-Mechanize-Shell-0.59/Makefile.PL0000644000175000017500000001662113654075102016430 0ustar corioncorion# -*- mode: perl; c-basic-offset: 4; indent-tabs-mode: nil; -*- use strict; use ExtUtils::MakeMaker qw(WriteMakefile); # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. # Normalize version strings like 6.30_02 to 6.3002, # so that we can do numerical comparisons on it. my $eumm_version = $ExtUtils::MakeMaker::VERSION; $eumm_version =~ s/_//; my $module = 'WWW::Mechanize::Shell'; (my $main_file = "lib/$module.pm" ) =~ s!::!/!g; (my $distbase = $module) =~ s!::!-!g; my $distlink = $distbase; my @tests = map { glob $_ } 't/*.t', 't/*/*.t'; my %module = ( NAME => $module, AUTHOR => q{Max Maischein }, VERSION_FROM => $main_file, ABSTRACT_FROM => $main_file, META_MERGE => { "meta-spec" => { version => 2 }, resources => { repository => { web => "https://github.com/Corion/$distlink", url => "git://github.com/Corion/$distlink.git", type => 'git', }, bugtracker => "https://rt.cpan.org/Public/Dist/Display.html?Name=$distbase", license => "https://dev.perl.org/licenses/", }, dynamic_config => 0, # we promise to keep META.* up-to-date x_static_install => 1, # we are pure Perl and don't do anything fancy }, MIN_PERL_VERSION => '5.006', # I use // in some places 'LICENSE'=> 'perl', PL_FILES => {}, BUILD_REQUIRES => { 'ExtUtils::MakeMaker' => 0, }, PREREQ_PM => { 'Term::Shell' => 0.02, 'parent' => 0, 'URI::URL' => 0.00, 'Test::Harness' => 2.30, 'LWP' => 5.69, 'LWP::UserAgent' => 0, 'WWW::Mechanize' => 1.20, 'WWW::Mechanize::Link' => 1.20, 'WWW::Mechanize::FormFiller' => 0.05, 'Hook::LexWrap' => 0.20, 'HTTP::Cookies' => 0, 'HTML::Display' => 0, 'HTML::TokeParser::Simple' => 2.0, }, TEST_REQUIRES => { 'Test::More' => 0, 'CGI' => 0, 'File::Temp' => 0, 'Test::HTTP::LocalServer' => '0.68', # we need basic auth handling 'URI' => 0, 'Test::Without::Module' => 0, # we lazy-load some optional modules }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => "$distbase-*" }, test => { TESTS => join( ' ', @tests ) }, ); # This is so that we can do # require 'Makefile.PL' # and then call get_module_info sub get_module_info { %module } if( ! caller ) { # I should maybe use something like Shipwright... regen_README($main_file); regen_EXAMPLES() if -d 'examples'; WriteMakefile1(get_module_info); }; 1; sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade. my %params=@_; my $eumm_version=$ExtUtils::MakeMaker::VERSION; $eumm_version=eval $eumm_version; die "EXTRA_META is deprecated" if exists $params{EXTRA_META}; die "License not specified" if not exists $params{LICENSE}; if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { #EUMM 6.5502 has problems with BUILD_REQUIRES $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; delete $params{BUILD_REQUIRES}; } if ($params{TEST_REQUIRES} and $eumm_version < 6.64) { $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{TEST_REQUIRES}} }; delete $params{TEST_REQUIRES}; } delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; delete $params{META_MERGE} if $eumm_version < 6.46; delete $params{META_ADD} if $eumm_version < 6.46; delete $params{LICENSE} if $eumm_version < 6.31; delete $params{AUTHOR} if $] < 5.005; delete $params{ABSTRACT_FROM} if $] < 5.005; delete $params{BINARY_LOCATION} if $] < 5.005; WriteMakefile(%params); } sub regen_README { # README is the short version that just tells people what this is # and how to install it eval { # Get description my $readme = join "\n", pod_section($_[0], 'NAME', 'no heading' ), pod_section($_[0], 'DESCRIPTION' ), <new(); # Read POD from Module.pm and write to README $parser->parse_from_file($_[0]); my $readme_mkdn = <as_markdown; [![Travis Build Status](https://travis-ci.org/Corion/$distlink.svg?branch=master)](https://travis-ci.org/Corion/$distlink) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/Corion/$distlink?branch=master&svg=true)](https://ci.appveyor.com/project/Corion/$distlink) STATUS update_file( 'README.mkdn', $readme_mkdn ); }; } sub pod_section { my( $filename, $section, $remove_heading ) = @_; open my $fh, '<', $filename or die "Couldn't read '$filename': $!"; my @section = grep { /^=head1\s+$section/.../^=/ } <$fh>; # Trim the section if( @section ) { pop @section if $section[-1] =~ /^=/; shift @section if $remove_heading; pop @section while @section and $section[-1] =~ /^\s*$/; shift @section while @section and $section[0] =~ /^\s*$/; }; @section = map { $_ =~ s!^=\w+\s+!!; $_ } @section; return join "", @section; } sub regen_EXAMPLES { my $perl = $^X; if ($perl =~/\s/) { $perl = qq{"$perl"}; }; (my $example_file = $main_file) =~ s!\.pm$!/Examples.pm!; my $examples = `$perl -w examples/gen_examples_pod.pl`; if ($examples) { warn "(Re)Creating $example_file\n"; $examples =~ s/\r\n/\n/g; update_file( $example_file, $examples ); }; }; sub update_file { my( $filename, $new_content ) = @_; my $content; if( -f $filename ) { open my $fh, '<', $filename or die "Couldn't read '$filename': $!"; binmode $fh; local $/; $content = <$fh>; }; if( $content ne $new_content ) { if( open my $fh, '>', $filename ) { binmode $fh; print $fh $new_content; } else { warn "Couldn't (re)write '$filename': $!"; }; }; } WWW-Mechanize-Shell-0.59/t/0000755000175000017500000000000013654075103014714 5ustar corioncorionWWW-Mechanize-Shell-0.59/t/27-form_number.t0000755000175000017500000000147413654075102017652 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib './inc'; use IO::Catch; our ($_STDOUT_, $_STDERR_); tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; tie *STDERR, 'IO::Catch', '_STDERR_' or die $!; use Test::More tests => 4; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; delete $ENV{PAGER} if $ENV{PAGER}; $ENV{PERL_HTML_DISPLAY_CLASS}="HTML::Display::Dump"; my @warnings; use_ok('WWW::Mechanize::Shell'); my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); my @status; { no warnings qw'once redefine'; *WWW::Mechanize::Shell::status = sub {}; }; $s->cmd('get file:t/27-index.html'); $s->option('warnings',1); eval { $s->cmd("form 2"); }; is($@, '', "Can execute 'form 2' for a page with two forms"); is($_STDOUT_,undef,"Nothing was printed"); is($_STDERR_,undef,"No warnings printed"); WWW-Mechanize-Shell-0.59/t/source.mech0000644000175000017500000000002613654075102017047 0ustar corioncorion# a test file content WWW-Mechanize-Shell-0.59/t/23-check-dumpresponses.t0000755000175000017500000000163213654075102021311 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib './inc'; use IO::Catch; use Test::HTTP::LocalServer; our ($_STDOUT_, $_STDERR_); tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; tie *STDERR, 'IO::Catch', '_STDERR_' or die $!; use Test::More tests => 5; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; delete @ENV{qw(HTTP_PROXY http_proxy CGI_HTTP_PROXY)}; use_ok('WWW::Mechanize::Shell'); my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); # Now test my $server = Test::HTTP::LocalServer->spawn(); { no warnings 'redefine','once'; local *WWW::Mechanize::Shell::status = sub {}; #$s->cmd("set dumprequests 1"); $s->cmd("set dumpresponses 1"); eval { $s->cmd( sprintf 'get "%s"', $server->url); }; is($@, "", "Get url worked"); isnt($_STDOUT_,undef,"Response was not undef"); isnt($_STDOUT_,"","Response was output"); isnt($s->agent->content,"","Retrieved content"); }; WWW-Mechanize-Shell-0.59/t/00-load.t0000644000175000017500000000057513654075102016243 0ustar corioncorion#!perl -T use strict; use warnings; use Test::More tests => 1; require './Makefile.PL'; my %module = get_module_info(); my $module = $module{ NAME }; require_ok( $module ); diag( sprintf "Testing %s %s, Perl %s", $module, $module->VERSION, $] ); for (sort grep /\.pm\z/, keys %INC) { s/\.pm\z//; s!/!::!g; eval { diag(join(' ', $_, $_->VERSION || '')) }; } WWW-Mechanize-Shell-0.59/t/25-save-file-nolink.t0000755000175000017500000000217113654075102020473 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib './inc'; use IO::Catch; use Test::HTTP::LocalServer; our ($_STDOUT_, $_STDERR_); tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; tie *STDERR, 'IO::Catch', '_STDERR_' or die $!; use Test::More tests => 6; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; delete @ENV{qw(HTTP_PROXY http_proxy CGI_HTTP_PROXY)}; delete $ENV{PAGER} if $ENV{PAGER}; $ENV{PERL_HTML_DISPLAY_CLASS}="HTML::Display::Dump"; use_ok('WWW::Mechanize::Shell'); my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); # Now test my $server = Test::HTTP::LocalServer->spawn(); { no warnings 'redefine', 'once'; local *WWW::Mechanize::Shell::status = sub {}; $s->cmd( sprintf 'get "%s"', $server->url); isnt($s->agent->content,"","Retrieved content"); $s->cmd("save"); is($_STDOUT_,"No link given to save\n","save error message"); is($_STDERR_,undef,"No warnings"); $_STDOUT_ = undef; $_STDERR_ = undef; $s->cmd("save /does-not-exist/"); like($_STDOUT_,'/No match for \/\(\?(-xism|\^):does-not-exist\)\/.\n/',"save RE error message"); is($_STDERR_,undef,"No warnings"); }; WWW-Mechanize-Shell-0.59/t/24-source-file.t0000755000175000017500000000224213654075102017543 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib './inc'; use IO::Catch; use Test::HTTP::LocalServer; our ( $_STDOUT_, $_STDERR_); tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; tie *STDERR, 'IO::Catch', '_STDERR_' or die $!; use Test::More tests => 5; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; delete $ENV{PAGER} if $ENV{PAGER}; $ENV{PERL_HTML_DISPLAY_CLASS}="HTML::Display::Dump"; delete @ENV{qw(HTTP_PROXY http_proxy CGI_HTTP_PROXY)}; require WWW::Mechanize::Shell; my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); # Now test my $server = Test::HTTP::LocalServer->spawn(); { no warnings 'redefine','once'; local *WWW::Mechanize::Shell::status = sub {}; $s->cmd( sprintf 'get "%s"', $server->url); isnt($s->agent->content,"","Retrieved content"); $s->cmd("source t/source.mech"); isnt($_STDOUT_,"","Sourcing a file works"); is($_STDERR_,undef,"No warnings"); }; { no warnings 'redefine','once'; my $warned; local *WWW::Mechanize::Shell::display_user_warning = sub { $warned++ }; $s->cmd("source t/does-not-exist.mech"); is($warned,1,"Warning for nonexistent files works"); is($_STDERR_,undef,"No warnings"); }; WWW-Mechanize-Shell-0.59/t/08-unknown-command.t0000755000175000017500000000147513654075102020452 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib './inc'; use IO::Catch; use File::Temp qw( tempfile ); # pre-5.8.0's warns aren't caught by a tied STDERR. tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; use Test::More tests => 2; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; SKIP: { #skip "Can't load Term::ReadKey without a terminal", 2 # unless -t STDIN; #eval { require Term::ReadKey; Term::ReadKey::GetTerminalSize(); }; #if ($@) { # no warnings 'redefine'; # *Term::ReadKey::GetTerminalSize = sub {80,24}; # diag "Term::ReadKey seems to want a terminal"; #}; use_ok('WWW::Mechanize::Shell'); # Silence all warnings my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); eval { $s->cmd('this_command_does_not_exist'); }; is($@,"","An unknown command does not crash the shell"); }; WWW-Mechanize-Shell-0.59/t/28-html-tableextract.t0000755000175000017500000000367313654075102020767 0ustar corioncorion#!/usr/bin/perl -w use strict; use Test::More tests => 3; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; delete $ENV{PAGER} if $ENV{PAGER}; $ENV{PERL_HTML_DISPLAY_CLASS}="HTML::Display::Dump"; use_ok('WWW::Mechanize::Shell'); my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); isa_ok $s, 'WWW::Mechanize::Shell'; my $have_tableextract = eval { require HTML::TableExtract; die "Need at least HTML::TableExtract v2, found '$HTML::TableExtract::VERSION'" unless $HTML::TableExtract::VERSION > 2; 1 }; SKIP: { if ($@) { skip "Error loading HTML::TableExtract: '$@'", 1; } elsif (! $have_tableextract) { skip "Unknown error loading HTML::TableExtract, skipping tests", 1; } else { no warnings qw'redefine once'; local *WWW::Mechanize::Shell::status = sub {}; my @output; local *WWW::Mechanize::Shell::print_paged = sub { shift @_; push @output, grep { /\S/ } @_; }; $s->agent->{base} = 'http://example.com'; $s->agent->update_html(<
IDagename
1John41
2Paul47
3George45
4Ringo47
HTML $s->cmd('table name age'); # TableExtract seems to be confused about the column order # hence we just check the number of rows: is(scalar @output, 5, "Five lines captured") or diag "@output"; } }; WWW-Mechanize-Shell-0.59/t/03-documentation.t0000644000175000017500000000163613654075102020177 0ustar corioncorionuse strict; use FindBin; our @methods; BEGIN { my $module = "$FindBin::Bin/../lib/WWW/Mechanize/Shell.pm"; open MODULE, "< $module" or die "Couldn't open module file '$module'"; @methods = map { /^\s*sub run_([a-z]+)\s*\{/ ? $1 : () } ; close MODULE; }; use Test::More tests => scalar @methods*3 +2; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; SKIP: { eval { require Pod::Constants;}; skip "Need Pod::Constants to test the documentation", 2 + scalar @methods*3 if $@; use_ok("WWW::Mechanize::Shell"); my $shell = WWW::Mechanize::Shell->new("shell", rcfile => undef, warnings => undef ); isa_ok($shell,"WWW::Mechanize::Shell"); for my $method (@methods) { my $helptext = $shell->catch_smry($method); is($@,'',"No error"); isnt( $helptext, undef, "Documentation for $method is there"); isnt( $helptext, '', "Documentation for $method is not empty"); }; }; WWW-Mechanize-Shell-0.59/t/04-history-invariant.t0000755000175000017500000000376013654075102021024 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib './inc'; use IO::Catch; # pre-5.8.0's warns aren't caught by a tied STDERR. tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; our( @history_invariant, @history_add ); BEGIN { # Disable all ReadLine functionality $ENV{PERL_RL} = 0; # Also disable the paged output of Term::Shell @history_invariant = qw( browse cookies dump eval exit forms history links parse quit restart script set source tables versions ct response title headers ); push @history_invariant, "headers 1","headers 12","headers 2","headers 12345"; push @history_invariant, "#"," #", "# a comment", " # another comment"; @history_add = qw( autofill back click content fillout get open reload save submit table ua value tick untick referer referrer timeout ); }; # For testing the "versions" command sub WWW::Mechanize::Shell::print_pairs {}; use Test::More tests => scalar @history_invariant +1; SKIP: { use_ok('WWW::Mechanize::Shell'); # Silence all warnings #$SIG{__WARN__} = sub {}; my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); $s->agent->{content} = ''; my @history; sub disable { my ($namespace,$subname) = @_; no strict 'refs'; no warnings 'redefine'; *{"$namespace\::$subname"} = sub { return }; }; { no warnings 'redefine','once'; *WWW::Mechanize::Shell::add_history = sub { shift; push @history, join "", @_; }; *WWW::Mechanize::links = sub {()}; }; disable( "WWW::Mechanize::Shell", $_ ) for (qw( restart_shell browser )); disable( "WWW::Mechanize",$_ ) for (qw( cookie_jar current_form forms )); disable( "Term::Shell",$_ ) for (qw( print_pairs )); for my $cmd (@history_invariant) { @history = (); $s->cmd($cmd); is_deeply( \@history, [], "$cmd is history invariant"); }; }; WWW-Mechanize-Shell-0.59/t/18-browser-autosync.t0000755000175000017500000000303513654075102020660 0ustar corioncorion#!/usr/bin/perl -w use strict; use Test::HTTP::LocalServer; use Test::More; use lib './inc'; use IO::Catch; # pre-5.8.0's warns aren't caught by a tied STDERR. tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; our %tests = ( back => { count => 3, commands => ['get %s','click submit','back']}, browse => { count => 2, commands => [ 'get %s', 'browse' ] }, get => { count => 1, commands => ['get %s']} , open => { count => 2, commands => ['get %s','open 1'] }, submit => { count => 2, commands => ['get %s','submit']}, click => { count => 2, commands => ['get %s','click submit']}, reload => { count => 2, commands => ['get %s','reload'] }, ); plan tests => scalar (keys %tests); BEGIN { # Disable all ReadLine functionality $ENV{PERL_RL} = 0; }; use WWW::Mechanize::Shell; my $browser_synced; { no warnings 'redefine'; *WWW::Mechanize::Shell::sync_browser = sub { $browser_synced++; }; }; my $server = Test::HTTP::LocalServer->spawn(); sub sync_ok { my %args = @_; my $name = $args{name}; my $count = $args{count}; my (@commands) = @{$args{commands}}; my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); $s->option('autosync', 1); $browser_synced = 0; for my $cmd (@commands) { no warnings; $cmd = sprintf $cmd, $server->url; $s->cmd($cmd); }; is($browser_synced,$count,"'$name' synchronizes $count times") or diag join "\n", @commands; }; for my $cmd (sort keys %tests) { sync_ok( name => $cmd, %{$tests{$cmd}} ); }; $server->stop; WWW-Mechanize-Shell-0.59/t/20-restart-without-script.t0000755000175000017500000000101313654075102022004 0ustar corioncorion#!/usr/bin/perl -w use strict; use Test::More tests => 4; BEGIN{ # Disable all ReadLine functionality $ENV{PERL_RL} = 0; use_ok("WWW::Mechanize::Shell"); }; delete @ENV{qw(HTTP_PROXY http_proxy CGI_HTTP_PROXY)}; my $output= `$^X -I./lib -MWWW::Mechanize::Shell -e "WWW::Mechanize::Shell->new('t',rcfile=>undef,warnings=>undef)->cmd('restart');print'OK'" 2>&1`; chomp $output; is($@, "","'restart' on -e dosen't crash"); is($?, 0,"'restart' on -e dosen't crash"); is($output,"OK","'restart' on -e dosen't crash"); WWW-Mechanize-Shell-0.59/t/00-use.t0000644000175000017500000000521413654075102016113 0ustar corioncorionuse strict; use Test::More tests => 22; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; $ENV{COLUMNS} = 80; $ENV{LINES} = 24; use_ok("WWW::Mechanize::Shell") or BAIL_OUT('Does not compile correctly'); diag "Running under $]"; for (qw(WWW::Mechanize LWP::UserAgent)) { diag "Using '$_' version " . $_->VERSION; }; my $s = do { WWW::Mechanize::Shell->new("shell",rcfile => undef, warnings => undef); }; isa_ok($s,"WWW::Mechanize::Shell"); # Now check our published API : for my $meth (qw( source_file cmdloop agent option restart_shell option cmd )) { can_ok($s,$meth); }; # Check that we can set known options # See also t/05-options.t my $oldvalue = $s->option('autosync'); $s->option('autosync',"foo"); is($s->option('autosync'),"foo","Setting an option works"); $s->option('autosync',$oldvalue); is($s->option('autosync'),$oldvalue,"Setting an option still works"); # Check that trying to set an unknown option gives an error { no warnings 'redefine'; my $called; local *Carp::carp = sub { $called++; }; $s->option('nonexistingoption',"foo"); is($called,1,"Setting an nonexisting option calls Carp::carp"); } { no warnings 'redefine'; my $called; my $filename; local *WWW::Mechanize::Shell::source_file = sub { $filename = $_[1]; $called++; }; my $test_filename = '/does/not/need/to/exist'; my $s = do { WWW::Mechanize::Shell->new("shell",rcfile => $test_filename, warnings => undef); }; isa_ok($s,"WWW::Mechanize::Shell"); ok($called,"Passing an .rc file tries to load it"); is($filename,$test_filename,"Passing an .rc file tries to load the right file"); }; { no warnings 'redefine'; my $called = 0; my $filename; local *WWW::Mechanize::Shell::source_file = sub { $filename = $_[1]; $called++; }; my $s = do { WWW::Mechanize::Shell->new("shell",rcfile => undef, warnings => undef); }; isa_ok($s,"WWW::Mechanize::Shell"); diag "Tried to load '$filename'" unless is($called,0,"Passing in no .rc file tries not to load it"); }; $s = WWW::Mechanize::Shell->new("shell",rcfile => undef, cookiefile => 'test.cookiefile', warnings => undef); isa_ok($s,"WWW::Mechanize::Shell"); is($s->option('cookiefile'),'test.cookiefile',"Passing in a cookiefile filename works"); # Also check what gets exported: ok(defined *main::shell{CODE},"'shell' gets exported"); { no warnings 'once'; is(*main::shell{CODE},*WWW::Mechanize::Shell::shell{CODE},"'shell' is the right sub"); }; { no warnings 'redefine','once'; my $called; local *WWW::Mechanize::Shell::cmdloop = sub { $called++ }; # Need to suppress status warnings here shell(warnings => undef); is($called,1,"Shell function works"); }; WWW-Mechanize-Shell-0.59/t/14-command-identity.t0000755000175000017500000004300513654075102020574 0ustar corioncorion#!/usr/bin/perl -w use strict; use FindBin; use File::Temp qw( tempfile ); our ($_STDOUT_, $_STDERR_ ); use URI::URL; #use LWP::Simple; use Test::HTTP::LocalServer; use Test::More; use lib './inc'; use IO::Catch; # Catch output: $SIG{__WARN__} = sub { $main::_STDERR_ .= join '', @_; }; tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; #tie *STDERR, 'IO::Catch', '_STDERR_' or die $!; # Make HTML::Display do nothing: BEGIN { $ENV{PERL_HTML_DISPLAY_CLASS} = 'HTML::Display::Dump'; delete $ENV{PAGER}; }; use HTML::Display; our %tests = ( autofill => { requests => 2, lines => [ 'get %s', 'autofill query Fixed foo', 'autofill cat Keep', 'autofill botcheck_query Fixed checked', 'autofill query2 Fixed bar', 'fillout', 'submit' ], location => qr'^%s/formsubmit$', values => { query2 => 'bar', query => 'foo' } }, auth => { requests => 1, lines => [ 'auth user password', 'get %s' ], location => qr'^%s/$' }, back => { requests => 2, lines => [ 'get %s','open 0','back' ], location => qr'^%s/$' }, content_save => { requests => 1, lines => [ 'get %s','content tmp.content','eval unlink "tmp.content"'], location => qr'^%s/$' }, comment => { requests => 1, lines => [ '# a comment','get %s','# another comment' ], location => qr'^%s/$' }, eval => { requests => 1, lines => [ 'eval "Hello World"', 'get %s','eval "Goodbye World"' ], location => qr'^%s/$' }, eval_shell => { requests => 1, lines => [ 'get %s', 'eval $self->agent->ct' ], location => qr'^%s/$' }, eval_sub => { requests => 2, lines => [ '# Fill in the "date" field with the current date/time as string', 'eval sub ::custom_today { "20030511" };', 'autofill session Callback ::custom_today', 'autofill query Keep', 'autofill botcheck_query Fixed checked', 'autofill query2 Fixed bar', 'autofill cat Keep', 'get %s', 'fillout', 'eval $self->agent->current_form->value("session")', 'submit', 'content', ], location => qr'^%s/formsubmit$', values => { query2 => 'bar', query => qr!\(empty\)!, session => '20030511' } }, eval_multiline => { requests => 2, lines => [ 'get %s', 'autofill query Keep', 'autofill cat Keep', 'autofill botcheck_query Fixed checked', 'autofill query2 Fixed bar', 'fillout', 'submit', 'eval "Hello World ", "from ",$self->agent->uri', 'content' ], location => qr'^%s/formsubmit$', values => { query2 => 'bar', query => qr!\(empty\)! }, }, form_name => { requests => 2, lines => [ 'get %s','form f','submit' ], location => qr'^%s/formsubmit$', values => { query2 => qr!\(empty\)!, query => qr!\(empty\)! }, }, form_num => { requests => 2, lines => [ 'get %s','form 1','submit' ], location => qr'^%s/formsubmit$', values => { query2 => qr!\(empty\)!, query => qr!\(empty\)! }, }, formfiller_chars => { requests => 2, lines => [ 'eval srand 0', 'autofill botcheck_query Fixed checked', 'autofill query2 Fixed bar', 'autofill cat Keep', 'autofill query Random::Chars size 5 set alpha', 'get %s', 'fillout','submit','content' ], values => { query2 => 'bar', query => qr!\w{5}! }, location => qr'^%s/formsubmit$' }, formfiller_date => { requests => 2, lines => [ 'eval srand 0', 'autofill botcheck_query Fixed checked', 'autofill query2 Fixed bar', 'autofill cat Keep', 'autofill query Random::Date string %%Y%%m%%d', 'get %s', 'fillout','submit','content' ], values => { query2 => 'bar', query => qr!\d{8}! }, location => qr'^%s/formsubmit$' }, formfiller_default => { requests => 2, lines => [ 'autofill query Default foo', 'autofill cat Keep', 'autofill botcheck_query Fixed checked', 'autofill query2 Fixed bar', 'get %s', 'fillout','submit','content' ], values => { query2 => 'bar', query => qr!\(empty\)! }, location => qr'^%s/formsubmit$' }, formfiller_fixed => { requests => 2, lines => [ 'autofill query Fixed foo', 'autofill cat Keep', 'autofill botcheck_query Fixed checked', 'autofill query2 Fixed bar', 'get %s', 'fillout','submit','content' ], values => { query2 => 'bar', query => 'foo' }, location => qr'^%s/formsubmit$' }, formfiller_keep => { requests => 2, lines => [ 'autofill query Keep', 'autofill cat Keep', 'autofill botcheck_query Fixed checked', 'autofill query2 Fixed bar', 'get %s', 'fillout','submit','content' ], values => { query2 => 'bar', query => qr!\(empty\)! }, location => qr'^%s/formsubmit$' }, formfiller_random => { requests => 2, lines => [ 'autofill query Random foo', 'autofill cat Keep', 'autofill botcheck_query Fixed checked', 'autofill query2 Fixed bar', 'get %s', 'fillout','submit','content' ], location => qr'^%s/formsubmit$' }, formfiller_re => { requests => 2, lines => [ 'eval srand 0', 'autofill cat Keep', 'autofill botcheck_query Fixed checked', 'autofill /qu/ Random::Date string %%Y%%m%%d', 'get %s', 'fillout','submit','content' ], values => { query2 => qr/^\d{8}$/, query => qr/^\d{8}$/ }, location => qr'^%s/formsubmit$' }, formfiller_word => { requests => 2, lines => [ 'eval srand 0', 'autofill cat Keep', 'autofill botcheck_query Fixed checked', 'autofill query2 Fixed bar', 'autofill query Random::Word size 1', 'get %s', 'fillout','submit','content' ], location => qr'^%s/formsubmit$' }, get => { requests => 1, lines => [ 'get %s' ], location => qr'^%s/' }, get_content => { requests => 1, lines => [ 'get %s', 'content' ], location => qr'^%s/' }, get_redirect => { requests => 2, lines => [ 'get %sredirect/startpage' ], location => qr'^%s/startpage' }, get_save => { requests => 4, lines => [ 'get %s','save "/\.save_log_server_test\.tmp$/"' ], location => qr'^%s/' }, get_value_click => { requests => 2, lines => [ 'get %s','value query foo', 'click submit' ], location => qr'^%s/formsubmit$' }, get_value_submit => { requests => 2, lines => [ 'get %s','value query foo', 'submit' ], location => qr'^%s/formsubmit$' }, get_value2_submit => { requests => 2, lines => [ 'get %s', 'value query foo', 'value session 2', 'submit' ], location => qr'^%s/formsubmit$', values => { session => '2', query => 'foo' }, }, interactive_script_creation => { requests => 2, lines => [ 'eval @::list=qw(foo bar xxx)', 'eval no warnings qw"redefine once"; *WWW::Mechanize::FormFiller::Value::Ask::ask_value = sub { my $value=shift @::list; push @{$_[0]->{shell}->{answers}}, [ $_[1]->name, $value ]; $value }', 'autofill cat Keep', 'autofill botcheck_query Fixed checked', 'autofill query2 Fixed bar', 'get %s', 'fillout', 'submit', 'content' ], location => qr'^%s/formsubmit$' }, open_parm => { requests => 2, lines => [ 'get %s','open 1','content' ], location => qr'^%s/test$' }, open_re => { requests => 2, lines => [ 'get %s','open "Link foo1.save_log_server_test.tmp"','content' ], location => qr'^%s/foo1.save_log_server_test.tmp$' }, open_re2 => { requests => 2, lines => [ 'get %s','open "/foo1/"','content' ], location => qr'^%s/foo1.save_log_server_test.tmp$' }, open_re3 => { requests => 2, lines => [ 'get %s','open "/Link /foo/"','content' ], location => qr'^%s/foo$' }, open_re4 => { requests => 2, lines => [ 'get %s','open "/Link \/foo/"','content' ], location => qr'^%s/foo$' }, open_re5 => { requests => 2, lines => [ 'get %s','open "/Link /$/"','content' ], location => qr'^%s/slash_end$' }, open_re6 => { requests => 2, lines => [ 'get %s','open "/^/Link$/"','content' ], location => qr'^%s/slash_front$' }, open_re7 => { requests => 2, lines => [ 'get %s','open "/^/Link in slashes//"','content' ], location => qr'^%s/slash_both$' }, reload => { requests => 2, lines => [ 'get %s','reload','content' ], location => qr'^%s/$' }, reload_2 => { requests => 3, lines => [ 'get %s','open "/Link \/foo/"','reload','content' ], location => qr'^%s/foo$' }, tick => { requests => 2, lines => [ 'get %s','tick cat cat_foo','submit','content' ], location => qr'^%s/formsubmit$' }, tick_all => { requests => 2, lines => [ 'get %s','tick cat','submit','content' ], location => qr'^%s/formsubmit$' }, timeout => { requests => 1, lines => [ 'timeout 60', 'get %s', 'content' ], location => qr'^%s/' }, ua_get => { requests => 1, lines => [ 'ua foo/1.1', 'get %s' ], location => qr'^%s/$' }, ua_get_content => { requests => 1, lines => [ 'ua foo/1.1', 'get %s', 'content' ], location => qr'^%s/$' }, untick => { requests => 2, lines => [ 'get %s','untick cat cat_foo','submit','content' ], location => qr'^%s/formsubmit$' }, untick_all => { requests => 2, lines => [ 'get %s','untick cat','submit','content' ], location => qr'^%s/formsubmit$' }, ); BEGIN { eval { require HTML::TableExtract; $tests{get_table} = { requests => 1, lines => [ 'get %s','table' ], location => qr'^%s/$' }; $tests{get_table_params} = { requests => 1, lines => [ 'get %s','table Col2 Col1' ], location => qr'^%s/$' }; }; # To ease zeroing in on tests if (@ARGV) { my $re = join "|", @ARGV; for (sort keys %tests) { delete $tests{$_} unless /$re/o; }; }; }; plan tests => (scalar keys %tests)*10; BEGIN { # Disable all ReadLine functionality $ENV{PERL_RL} = 0; #require LWP::UserAgent; #my $old = \&LWP::UserAgent::request; #print STDERR $old; #*LWP::UserAgent::request = sub {print STDERR "LWP::UserAgent::request\n"; goto &$old }; }; use WWW::Mechanize::Shell; SKIP: { # We want to be safe from non-resolving local host names delete @ENV{qw(HTTP_PROXY http_proxy CGI_HTTP_PROXY)}; our ($actual_requests, $dumped_requests ); { no warnings qw'redefine once'; my $old_request = *WWW::Mechanize::_make_request{CODE}; *WWW::Mechanize::_make_request = sub { $actual_requests++; goto &$old_request; }; *WWW::Mechanize::Shell::status = sub {}; *WWW::Mechanize::Shell::request_dumper = sub { $dumped_requests++; return 1 }; #*Hook::LexWrap::Cleanup::DESTROY = sub { #print STDERR "Disabling hook.\n"; #$_[0]->(); #}; }; my $server = Test::HTTP::LocalServer->spawn(); diag "Spawned local test server at " . $server->url; for my $name (sort keys %tests) { $_STDOUT_ = ''; undef $_STDERR_; $actual_requests = 0; $dumped_requests = 0; my @lines = @{$tests{$name}->{lines}}; my $requests = $tests{$name}->{requests}; my $code_port = $server->port; my $url = $server->url; $url =~ s!/$!!; my $result_location = sprintf $tests{$name}->{location}, quotemeta $url; $result_location = qr{$result_location}; my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); $s->option("dumprequests",1); my @commands; eval { for my $line (@lines) { no warnings; $line = sprintf $line, $server->url; push @commands, $line; $s->cmd($line); }; }; is $@, '', "Commands ran without dieing" or do { diag for @commands }; $s->cmd('eval $self->agent->uri'); my $code_output = $_STDOUT_; diag join( "\n", $s->history ) unless like($s->agent->uri,$result_location,"Shell moved to the specified url for $name"); my $parameters_ok = 1; my $expected_values = $tests{$name}->{values}; for my $valname (sort keys %$expected_values) { if( $s->agent->value( $valname ) !~ /^$expected_values->{ $valname }$/) { $parameters_ok = 0; diag sprintf "Expected '%s', got '%s'", $expected_values->{ $valname }, $s->agent->value( $valname ), ; }; }; is $parameters_ok, 1, "All parameters matched"; diag join( "\n", $s->history ) unless like($s->agent->uri,$result_location,"Shell moved to the specified url for $name"); is($_STDERR_,undef,"Shell produced no error output for $name"); is($actual_requests,$requests,"$requests requests were made for $name"); is($dumped_requests,$requests,"$requests requests were dumped for $name"); my $code_requests = $server->get_log; # Get a clean start my $script_port = $server->port; # Modify the generated Perl script to match the new? port my $script = join "\n", $s->script; s!\b$code_port\b!$script_port!smg for ($script, $code_output); #print STDERR "Releasing hook"; undef $s->{request_wrapper}; #{ # local *WWW::Mechanize::Shell::request_dumper = sub { die }; # use HTTP::Request::Common; # $s->agent->request(GET 'http://google.de/'); #}; $s->release_agent; undef $s; # Write the generated Perl script my ($fh,$tempname) = tempfile(); print $fh $script; close $fh; my ($compile) = `"$^X" -c "$tempname" 2>&1`; chomp $compile; SKIP: { unless (is($compile,"$tempname syntax OK","$name compiles")) { $server->get_log; diag $script; skip "Script $name didn't compile", 2; }; my ($output); my $command = qq("$^X" -Iblib/lib "$tempname" 2>&1); $output = `$command`; $output =~ s!^Cookie:.*$!Cookie: !smg; # cookies get re-ordered, sometimes $code_output =~ s!^Cookie:.*$!Cookie: !smg; # cookies get re-ordered, sometimes is( $output, $code_output, "Output of $name is identical" ) or diag "Script:\n$script"; my $script_requests = $server->get_log; $code_requests =~ s!\b$code_port\b!$script_port!smg; $code_requests =~ s!^Cookie:.*$!Cookie: !smg; # cookies get re-ordered, sometimes $script_requests =~ s!^Cookie:.*$!Cookie: !smg; # cookies get re-ordered, sometimes is($code_requests,$script_requests,"$name produces identical queries") or diag $script; }; unlink $tempname or diag "Couldn't remove tempfile '$name' : $!"; }; # $server->stop; unlink $_ for (<*.save_log_server_test.tmp>); }; WWW-Mechanize-Shell-0.59/t/12-comments.t0000755000175000017500000000213013654075102017144 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib './inc'; use IO::Catch; our ($_STDOUT_, $_STDERR_ ); # pre-5.8.0's warns aren't caught by a tied STDERR. tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; tie *STDERR, 'IO::Catch', '_STDERR_' or die $!; our @comments = ( "#", "# a test", "#eval 1", "# eval 1", "## eval 1" ); # Disable all ReadLine functionality $ENV{PERL_RL} = 0; use Test::More; plan tests => 1 + scalar @comments * 3; SKIP: { #skip "Can't load Term::ReadKey without a terminal", 1 + scalar @comments * 3 # unless -t STDIN; #eval { require Term::ReadKey; Term::ReadKey::GetTerminalSize(); }; #if ($@) { # no warnings 'redefine'; # *Term::ReadKey::GetTerminalSize = sub {80,24}; # diag "Term::ReadKey seems to want a terminal"; #}; use_ok('WWW::Mechanize::Shell'); my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); for (@comments) { $_STDOUT_ = ""; $_STDERR_ = ""; eval { $s->cmd($_); }; is($@,"","Comment '$_' produces no error"); is($_STDOUT_,"","Comment '$_' produces no output"); is($_STDERR_,"","Comment '$_' produces no error output"); }; }; WWW-Mechanize-Shell-0.59/t/00a-Term-Shell-catch-smry.t0000755000175000017500000000263013654075102021506 0ustar corioncorionuse strict; use Test::More tests => 1; use lib 'inc'; use IO::Catch; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; $ENV{COLUMNS} = 80; $ENV{LINES} = 24; TODO: { #local $TODO = "Term::Shell::catch_smry is buggy"; # Now check that the Term::Shell summary calls catch_smry require Term::Shell; our $called; { package Term::Shell::Test; use base 'Term::Shell'; sub summary { $::called++ }; sub print_pairs {}; }; my $s = { handlers => { foo => { run => sub {}}} }; bless $s, 'Term::Shell::Test'; { local *STDOUT; tie *STDOUT, 'IO::Catch', '_STDOUT_'; $s->run_help(); }; if (not is($called,1,"Term::Shell::Test::catch_smry gets called for unknown methods")) { diag "Term::Shell did not call a custom catch_smry handler"; diag "This is most likely because your version of Term::Shell"; diag "has a bug. Please upgrade to v0.02 or higher, which"; diag "should close this bug."; diag "If that is no option, patch sub help() in Term/Shell.pm, line 641ff."; diag "to:"; diag ' #my $smry = exists $o->{handlers}{$h}{smry};'; diag ' #? $o->summary($h);'; diag ' #: "undocumented";'; diag ' my $smry = $o->summary($h);'; diag 'Fixing this is not necessary - you will get no online help'; diag 'but the shell will otherwise work fine. Help is still'; diag 'available through ``perldoc WWW::Mechanize::Shell``'; }; }; WWW-Mechanize-Shell-0.59/t/15-history-save.t0000755000175000017500000000320713654075102017765 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib './inc'; use IO::Catch; use File::Temp qw( tempfile ); # pre-5.8.0's warns aren't caught by a tied STDERR. tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; use Test::More tests => 6; # Disable all ReadLine functionality BEGIN { $ENV{PERL_RL} = 0; }; use WWW::Mechanize::Shell; my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); my ($fh,$name) = tempfile(); close $fh; $s->cmd('autofill foo Fixed bar'); $s->cmd(sprintf 'history "%s"', $name); my $script = join("\n", $s->history)."\n"; ok(-f $name, "History file exists"); open F, "< $name" or die "Couldn't open tempfile $name : $!"; my $file = do { local $/; }; close F; is($file, $script, "Written history is the same as history()"); unlink $name or warn "Couldn't remove tempfile $name : $!"; ($fh,$name) = tempfile(); close $fh; $s->cmd(sprintf 'script "%s"', $name); $script = join("\n", $s->script(" "))."\n"; ok(-f $name, "Script file exists"); open F, "< $name" or die "Couldn't open tempfile $name : $!"; $file = do { local $/; }; close F; is($file, $script, "Written script is the same as script()"); unlink $name or warn "Couldn't remove tempfile $name : $!"; ($fh,$name) = tempfile(); close $fh; $s->agent->{content} = "test"; $s->cmd(sprintf 'content "%s"', $name); my $content = $s->agent->content . "\n"; ok(-f $name, "Script file exists"); open F, "< $name" or die "Couldn't open tempfile $name : $!"; $file = do { local $/; }; close F; is($file, $content, 'Written content is the same as $agent->content'); unlink $name or warn "Couldn't remove tempfile $name : $!"; WWW-Mechanize-Shell-0.59/t/02-fallback-HTML-TableExtract.t0000755000175000017500000000236113654075102022205 0ustar corioncorionuse strict; use Test::More tests => 4; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; SKIP: { #skip "Can't load Term::ReadKey without a terminal", 4 # unless -t STDIN; eval { require Test::Without::Module; Test::Without::Module->import('HTML::TableExtract') }; skip "Need Test::Without::Module to test the fallback", 4 if $@; #eval { require Term::ReadKey; Term::ReadKey::GetTerminalSize(); }; #if ($@) { # no warnings 'redefine'; # *Term::ReadKey::GetTerminalSize = sub {80,24}; # diag "Term::ReadKey seems to want a terminal"; #}; use_ok("WWW::Mechanize::Shell"); my $shell = do { WWW::Mechanize::Shell->new("shell", rcfile => undef, warnings => undef ); }; isa_ok($shell,"WWW::Mechanize::Shell"); my $text; my $warned; { local $SIG{__WARN__} = sub { $warned = $_[0]; }; $shell->option('warnings',1); eval { $shell->cmd("tables"); }; }; is( $@, '', "No error without HTML::TableExtract"); my $pass = ($warned =~ qr'^HTML\W+TableExtract\.pm did not return a true value') || ($warned =~ qr!^Can't locate HTML/TableExtract.pm in \@INC!); ok $pass, "Missing HTML::TableExtract raises warning" or diag "Caught warning '$warned'"; }; WWW-Mechanize-Shell-0.59/t/09-invalid-filename.t0000755000175000017500000000150113654075102020532 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib './inc'; use IO::Catch; use File::Temp qw( tempfile ); # pre-5.8.0's warns aren't caught by a tied STDERR. tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; use Test::More tests => 2; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; SKIP: { #skip "Can't load Term::ReadKey without a terminal", 2 # unless -t STDIN; #eval { require Term::ReadKey; Term::ReadKey::GetTerminalSize(); }; #if ($@) { # no warnings 'redefine'; # *Term::ReadKey::GetTerminalSize = sub {80,24}; # diag "Term::ReadKey seems to want a terminal"; #}; use_ok('WWW::Mechanize::Shell'); # Silence all warnings my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); eval { $s->cmd('source this_file_does_not_exist'); }; is($@,"","A nonexisting file does not crash the shell"); }; WWW-Mechanize-Shell-0.59/t/28-cmd-title.t0000755000175000017500000000345413654075102017222 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib './inc'; use IO::Catch; our $_STDOUT_; tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; delete $ENV{PAGER} if $ENV{PAGER}; $ENV{PERL_HTML_DISPLAY_CLASS}="HTML::Display::Dump"; use Test::More tests => 6; use_ok('WWW::Mechanize::Shell'); my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); isa_ok $s, 'WWW::Mechanize::Shell'; SKIP: { $s->agent->{base} = 'http://example.com'; $s->agent->update_html(< An HTML page Some body HTML $s->cmd('title'); chomp $_STDOUT_; is($_STDOUT_,"An HTML page", "Title gets output correctly"); undef $_STDOUT_; $s->agent->update_html(< Some body HTML $s->cmd('title'); chomp $_STDOUT_; is($_STDOUT_,"", "Empty title gets output correctly"); undef $_STDOUT_; $s->agent->update_html(< 0 Some body HTML $s->cmd('title'); chomp $_STDOUT_; is($_STDOUT_,"0", "False title gets output correctly"); undef $_STDOUT_; $s->agent->update_html(< Some body HTML $s->cmd('title'); chomp $_STDOUT_; is($_STDOUT_,"", "A missing title gets output correctly"); }; WWW-Mechanize-Shell-0.59/t/05-options.t0000755000175000017500000000250713654075102017024 0ustar corioncorion#!/usr/bin/perl -w use strict; our @options = (qw( autosync autorestart watchfiles cookiefile dumprequests dumpresponses verbose warnings )); use Test::More; plan tests => scalar @options*4 +4; BEGIN { $ENV{PERL_RL} = 0; }; require WWW::Mechanize::Shell; my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); for my $option (@options) { my $oldval = $s->option($option); my $oldval2 = $s->option($option,"newvalue"); is( $s->option($option), "newvalue", "Setting option '$option' via ->option()" ); is( $oldval, $oldval2, "->option('$option','newvalue') returns the previous value"); is( $s->option($option,$oldval2), "newvalue", "->option('$option','newvalue') returns the previous value (2)"); is( $s->option($option), $oldval, "Setting option '$option' via ->option() (2)"); }; my $warned; no warnings 'redefine'; local *Carp::carp = sub { $warned = $_[0] }; my $res = $s->option('doesnotexist'); is( $res, undef, "Nonexisting option returns undef"); is( $warned, "Unknown option 'doesnotexist'", "Nonexisting option raises a warning"); $res = $s->option('doesnotexist','newvalue'); is( $res, undef, "Nonexisting option returns undef" ); is( $warned, "Unknown option 'doesnotexist'","Nonexisting option raises a warning" ); WWW-Mechanize-Shell-0.59/t/embedded-WWW-Mechanize-Shell.t0000644000175000017500000000530613654075102022265 0ustar corioncorion#!/opt/perl58/bin/perl -w use Test::More 'no_plan'; package Catch; sub TIEHANDLE { my($class, $var) = @_; return bless { var => $var }, $class; } sub PRINT { my($self) = shift; ${'main::'.$self->{var}} .= join '', @_; } sub OPEN {} # XXX Hackery in case the user redirects sub CLOSE {} # XXX STDERR/STDOUT. This is not the behavior we want. sub READ {} sub READLINE {} sub GETC {} sub BINMODE {} my $Original_File = 'lib/WWW/Mechanize/Shell.pm'; package main; # pre-5.8.0's warns aren't caught by a tied STDERR. $SIG{__WARN__} = sub { $main::_STDERR_ .= join '', @_; }; tie *STDOUT, 'Catch', '_STDOUT_' or die $!; tie *STDERR, 'Catch', '_STDERR_' or die $!; SKIP: { # A header testing whether we find all prerequisites : # Check for module WWW::Mechanize::Shell eval { require WWW::Mechanize::Shell }; skip "Need module WWW::Mechanize::Shell to run this test", 1 if $@; # Check for module strict eval { require strict }; skip "Need module strict to run this test", 1 if $@; # The original POD test undef $main::_STDOUT_; undef $main::_STDERR_; eval q{ my $example = sub { local $^W = 0; #line 33 lib/WWW/Mechanize/Shell.pm #!/usr/bin/perl -w use strict; use WWW::Mechanize::Shell; my $shell = WWW::Mechanize::Shell->new("shell"); if (@ARGV) { $shell->source_file( @ARGV ); } else { $shell->cmdloop; }; ; } }; is($@, '', "example from line 33"); }; SKIP: { # A header testing whether we find all prerequisites : # Check for module WWW::Mechanize::Shell eval { require WWW::Mechanize::Shell }; skip "Need module WWW::Mechanize::Shell to run this test", 1 if $@; # Check for module strict eval { require strict }; skip "Need module strict to run this test", 1 if $@; # The original POD test { undef $main::_STDOUT_; undef $main::_STDERR_; #line 33 lib/WWW/Mechanize/Shell.pm #!/usr/bin/perl -w use strict; use WWW::Mechanize::Shell; my $shell = WWW::Mechanize::Shell->new("shell"); if (@ARGV) { $shell->source_file( @ARGV ); } else { $shell->cmdloop; }; BEGIN { require WWW::Mechanize::Shell; $ENV{PERL_RL} = 0; $ENV{COLUMNS} = '80'; $ENV{LINES} = '24'; }; BEGIN { no warnings 'once'; no warnings 'redefine'; *WWW::Mechanize::Shell::cmdloop = sub {}; *WWW::Mechanize::Shell::display_user_warning = sub {}; *WWW::Mechanize::Shell::source_file = sub {}; }; isa_ok( $shell, "WWW::Mechanize::Shell" ); undef $main::_STDOUT_; undef $main::_STDERR_; } }; SKIP: { # A header testing whether we find all prerequisites : # The original POD test undef $main::_STDOUT_; undef $main::_STDERR_; }; WWW-Mechanize-Shell-0.59/t/29-launch-shell.t0000755000175000017500000000121213654075102017706 0ustar corioncorion#!/usr/bin/perl -w use strict; use Test::More tests => 4; use File::Spec; use File::Temp qw(tempfile); my $perl = $^X; if ($perl =~ /\s/) { $perl = qq{"$perl"}; }; my ($fh,$temp) = tempfile(); print {$fh} "quit\n"; close $fh; my $res = system($perl, "-I./blib/lib", "-MWWW::Mechanize::Shell", "-eshell(warnings=>undef)", $temp); is $res,0,"Shell launch works"; is $?, 0, "No error on exit"; unlink $temp or diag "Couldn't remove '$temp': $!"; use_ok "WWW::Mechanize::Shell"; my $s = WWW::Mechanize::Shell->new("shell",warnings=>undef); my $prompt = eval { $s->prompt_str }; is $@, '', "prompt_str() doesn't die for empty WWW::Mechanize"; WWW-Mechanize-Shell-0.59/t/11-browse-without-request.t0000755000175000017500000000072213654075102022013 0ustar corioncorion#!/usr/bin/perl -w use strict; use Test::More tests => 2; BEGIN { # Choose a nonannoying HTML displayer: $ENV{PERL_HTML_DISPLAY_CLASS} = 'HTML::Display::Dump'; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; use_ok('WWW::Mechanize::Shell'); }; my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); # Now test eval { $s->cmd('browse'); }; is($@, "", "Browsing without requesting anything does not crash the shell"); WWW-Mechanize-Shell-0.59/t/01-fallback-Win32-OLE.t0000644000175000017500000000106713654075102020376 0ustar corioncorionuse strict; use Test::More tests => 3; # Disable all ReadLine functionality SKIP: { $ENV{PERL_RL} = 0; eval { require Test::Without::Module; Test::Without::Module->import('Win32::OLE') }; skip "Need Test::Without::Module to test the fallback", 3 if $@; use_ok("WWW::Mechanize::Shell"); my $shell = do { WWW::Mechanize::Shell->new("shell", rcfile => undef, warnings => undef ); }; isa_ok($shell,"WWW::Mechanize::Shell"); my $browser; eval { $browser = $shell->browser; }; is( $@, '', "No error without Win32::OLE"); }; WWW-Mechanize-Shell-0.59/t/06-valid-output.t0000755000175000017500000000736013654075102017771 0ustar corioncorion#!/usr/bin/perl -w use strict; use Test::More; use File::Temp qw( tempfile ); use WWW::Mechanize::Link; use lib './inc'; use IO::Catch; # pre-5.8.0's warns aren't caught by a tied STDERR. tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; BEGIN { # Choose a nonannoying HTML displayer: $ENV{PERL_HTML_DISPLAY_CLASS} = 'HTML::Display::Dump'; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; }; our %tests = ( 'autofill' => 'autofill test Fixed value', 'back' => 'back', 'click' => 'click', 'content' => 'content', 'eval' => 'eval 1', 'fillout' => 'fillout', 'get @' => 'get http://admin@www.google.com/', 'get plain' => 'get http://www.google.com/', 'open' => 'open "foo link"', 'reload' => 'reload', 'referrer' => 'referrer ""', 'referrer val' => 'referrer "foo"', 'referer' => 'referer ""', 'save' => 'save 0', 'save re' => 'save /.../', 'submit' => 'submit', 'tick' => 'tick key value', 'tick_all' => 'tick key', 'timeout' => 'timeout 60', 'value' => 'value key value', 'ua' => 'ua foo/1.1', 'untick' => 'untick key value', 'untick_all' => 'untick key', ); eval { require HTML::TableExtract; $HTML::TableExtract::VERSION >= 2 or die "Need HTML::TableExtract version >= 2"; $tests{table} = 'table'; $tests{'table params'} = 'table foo bar'; }; plan tests => scalar (keys %tests)*2; use WWW::Mechanize::Shell; SKIP: { eval { require Test::MockObject; Test::MockObject->import(); }; skip "Test::MockObject not installed", scalar (keys %tests)*2 if $@; my $mock_result = Test::MockObject->new; $mock_result->set_always( code => 200 ); my $mock_form = Test::MockObject->new; $mock_form->mock( value => sub {} ) ->set_list( inputs => ()) ->set_list( find_input => ()); my $mock_agent = Test::MockObject->new; $mock_agent->set_true($_) for qw( back content get open ); $mock_agent->set_false($_) for qw( form forms ); my $mock_uri = Test::MockObject->new; $mock_uri->set_always( abs => 'http://example.com/' ) ->set_always( path => '/' ); $mock_uri->fake_module( 'URI::URL', new => sub {$mock_uri} ); $mock_agent->set_always( res => $mock_result ) ->set_always( add_header => 1 ) ->set_always( submit => $mock_result ) ->set_always( click => $mock_result ) ->set_always( reload => $mock_result ) ->set_always( current_form => $mock_form ) ->set_always( follow_link => 1 ) ->set_list( links => WWW::Mechanize::Link->new('foo','foo link','foo_link',""), WWW::Mechanize::Link->new('foo2','foo2 link','foo2_link',"")) ->set_always( agent => 'foo/1.0' ) ->set_always( tick => 1 ) ->set_always( timeout => 1 ) ->set_always( untick => 1 ) ->set_always( uri => $mock_uri ); my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef, watchfiles => undef ); $s->{agent} = $mock_agent; my @history; { no warnings 'redefine'; *WWW::Mechanize::Shell::add_history = sub { shift; # warn $_ for @_; push @history, join "", @_; }; }; sub compiles_ok { my ($command,$testname) = @_; $testname ||= $command; @history = (); $s->cmd($command); local $, = "\n"; my ($fh,$name) = tempfile(); print $fh ( "@history" ); close $fh; ok( scalar @history != 0, "$testname is history relevant"); my $output = `$^X -Ilib -c $name 2>&1`; chomp $output; is( $output, "$name syntax OK", "$testname compiles") or diag "Created file was :\n@history"; unlink $name or diag "Couldn't remove tempfile '$name' : $!"; }; foreach my $name (sort keys %tests) { compiles_ok( $tests{$name},$name ); }; }; WWW-Mechanize-Shell-0.59/t/07-history-items.t0000755000175000017500000000673413654075102020161 0ustar corioncorion#!/usr/bin/perl -w use strict; use Test::More; use File::Temp qw( tempfile ); use WWW::Mechanize::Link; use lib './inc'; use IO::Catch; # pre-5.8.0's warns aren't caught by a tied STDERR. tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; BEGIN { # Disable all ReadLine functionality $ENV{PERL_RL} = 0; }; our %tests = ( 'autofill' => 'autofill test Fixed value', 'back' => 'back', 'click' => 'click', 'content' => 'content', 'eval' => 'eval 1', 'fillout' => 'fillout', 'form' => 'form 1', 'form' => 'form test', 'get @' => 'get http://admin@www.google.com/', 'get plain' => 'get http://www.google.com/', 'open' => 'open "foo link"', 'reload' => 'reload', 'referer' => 'referer ""', 'referrer' => 'referrer ""', 'save' => 'save /.../', 'submit' => 'submit', 'value' => 'value key value', 'ua' => 'ua foo/1.0', 'tick' => 'tick key value', 'tick_all' => 'tick key', 'timeout' => 'timeout 60', 'untick' => 'untick key value', 'untick_all' => 'untick key', ); eval { require HTML::TableExtract; $tests{table} = 'table'; $tests{table params} = 'table foo bar'; ; }; plan tests => scalar (keys %tests) +1; SKIP: { eval { require Test::MockObject; Test::MockObject->import(); }; skip "Test::MockObject not installed", scalar keys(%tests) +1 if $@; my $mock_result = Test::MockObject->new; $mock_result->set_always( code => 200 ); my $mock_form = Test::MockObject->new; $mock_form->mock( value => sub {} ) ->set_list( inputs => ()) ->set_list( find_input => ()) ->mock( dump => sub {} ) ->set_always( form_name => 'foo' ); my $mock_uri = Test::MockObject->new; $mock_uri->set_always( abs => 'http://example.com/' ) ->set_always( path => '/' ); $mock_uri->fake_module( 'URI::URL', new => sub {$mock_uri} ); my $mock_agent = Test::MockObject->new; $mock_agent->set_true($_) for qw( back content get mirror open follow ); $mock_agent->set_false($_) for qw( form forms ); $mock_agent->set_always( res => $mock_result ) ->set_always( add_header => 1 ) ->set_always( submit => $mock_result ) ->set_always( click => $mock_result ) ->set_always( reload => $mock_result ) ->set_always( current_form => $mock_form ) ->set_always( form_name => 'test form name' ) ->set_always( follow_link => 1 ) ->set_list( links => WWW::Mechanize::Link->new('foo','foo link','foo_link',""), WWW::Mechanize::Link->new('foo2','foo2 link','foo2_link',"")) ->set_always( agent => 'mocked/1.0') ->set_always( uri => $mock_uri ) ->set_always( request => $mock_result ) ->set_always( tick => 1 ) ->set_always( timeout => 1 ) ->set_always( untick => 1 ) ; use_ok('WWW::Mechanize::Shell'); my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef, watchfiles => undef ); $s->{agent} = $mock_agent; my @history; { no warnings 'redefine','once'; *WWW::Mechanize::Shell::add_history = sub { my $shell = shift; push @history, $shell->line; }; }; sub exactly_one_line { my ($command,$testname) = @_; $testname ||= $command; @history = (); $s->cmd($command); is_deeply([@history],[$command],"$testname adds one line to history"); }; foreach my $name (sort keys %tests) { exactly_one_line( $tests{$name},$name ); }; }; WWW-Mechanize-Shell-0.59/t/17-eval-multiline.t0000755000175000017500000000207013654075102020256 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib './inc'; use IO::Catch; use File::Temp qw( tempfile ); our ($_STDOUT_, $_STDERR_); # pre-5.8.0's warns aren't caught by a tied STDERR. tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; tie *STDERR, 'IO::Catch', '_STDERR_' or die $!; use Test::More tests => 7; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; use_ok('WWW::Mechanize::Shell'); sub command_ok { my ($command,$expected,$name) = @_; my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); $s->agent->get("file:t/17-eval-multiline.t"); eval { $s->cmd($command) }; is($@,"","$name does not crash") or diag "Crash on '$command'"; is($_STDERR_,undef,"$name produces no warnings"); is($_STDOUT_,$expected,"$name produces the desired output") or diag "Command: '$command'"; undef $_STDOUT_; undef $_STDERR_; }; command_ok('eval "Hello", " World"', "Hello World\n","Multiline eval"); command_ok('eval "Hello from ", $self->agent->uri || ""', "Hello from file:t/17-eval-multiline.t\n","Multiline eval substitution"); WWW-Mechanize-Shell-0.59/t/27-index.html0000644000175000017500000000264013654075102017140 0ustar corioncorion

Mui.


Nothing happens.
#KursnameBeschreibungmax. Teiln.Teilnehmermaxim. zus. EntgeltKarte erforderl.Info
1001Aerobic - AnfängerAnfänger7005.00?nein
1002Aerobic - FortgeschritteneFortgeschrittene7005.00?nein
WWW-Mechanize-Shell-0.59/t/21-autofill-re.t0000755000175000017500000000161313654075102017547 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib './inc'; use File::Temp qw( tempfile ); use IO::Catch; our ($_STDOUT_, $_STDERR_); # pre-5.8.0's warns aren't caught by a tied STDERR. tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; tie *STDERR, 'IO::Catch', '_STDERR_' or die $!; use Test::More tests => 2; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; use_ok('WWW::Mechanize::Shell'); my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); $s->agent->{content} = q{
}; $s->agent->{forms} = [ HTML::Form->parse($s->agent->{content}, "http://www.example.com/" )]; $s->agent->{form} = $s->agent->{forms}->[0]; $s->cmd( 'autofill /qu/i Fixed "filled"' ); $s->cmd( 'fillout' ); is($s->agent->current_form->find_input("query")->value,"filled", "autofill via RE works"); WWW-Mechanize-Shell-0.59/t/13-command-au.t0000755000175000017500000000265713654075102017357 0ustar corioncorion#!/usr/bin/perl -w use strict; use FindBin; use lib './inc'; use IO::Catch; our ( $_STDOUT_, $_STDERR_ ); use URI; use Test::HTTP::LocalServer; # pre-5.8.0's warns aren't caught by a tied STDERR. tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; use Test::More tests => 4; use WWW::Mechanize::Shell; my $server = Test::HTTP::LocalServer->spawn(); my $user = 'foo'; my $pass = 'bar'; my $url = URI->new( $server->basic_auth($user => $pass)); my $host = $url->host; my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); # Try without credentials: my $bare_url = $url; diag "get $bare_url"; $s->cmd( "get $bare_url" ); my $code = $s->agent->response->code; my $got_url = $s->agent->uri; if (! is $code, 401, "Request without credentials gives 401") { diag "Page location : " . $s->agent->uri; }; # Now try the shell command for authentication with bad credentials $s->cmd( "auth x$user x$pass" ); $bare_url = $url; diag "get $bare_url"; eval { $s->cmd( "get $bare_url" ); }; is $s->agent->res->code, 401, "Wrong password still results in a 401"; like $@, qr/Auth Required/, "We die because of that"; # Now try the shell command for authentication with correct credentials $s->cmd( "auth $user $pass" ); $s->cmd( "get $bare_url" ); is $s->agent->res->code, 200, "Right password results in 200"; #diag "Shutting down test server at $url"; $server->stop; WWW-Mechanize-Shell-0.59/t/19-value-multi.t0000755000175000017500000000444613654075102017606 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib './inc'; use IO::Catch; # pre-5.8.0's warns aren't caught by a tied STDERR. $SIG{__WARN__} = sub { $main::_STDERR_ .= join '', @_; }; tie *STDERR, 'IO::Catch', '_STDERR_' or die $!; tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; use Test::More tests => 1 +3; BEGIN { # Disable all ReadLine functionality $ENV{PERL_RL} = 0; use_ok('WWW::Mechanize::Shell'); }; TODO: { local $TODO = "Implement passing of multiple values"; my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); $s->agent->{content} = join "", ; $s->agent->{forms} = [ HTML::Form->parse($s->agent->{content}, 'http://localhost/test/') ]; $s->agent->{form} = @{$s->agent->{forms}} ? $s->agent->{forms}->[0] : undef; $s->cmd('value cat cat_foo cat_bar cat_baz'); is_deeply([$s->agent->current_form->find_input('cat')->form_name_value],[qw[cat cat_foo cat cat_bar cat cat_baz]]) or diag $s->agent->current_form->find_input('cat')->form_name_value; $s->cmd('value cat ""'); is_deeply([$s->agent->current_form->find_input('cat')],[]); $s->cmd('value cat "cat_bar"'); is_deeply([$s->agent->current_form->find_input('cat')],[qw[cat_bar]]); }; __DATA__ WWW::Mechanize::Shell test page

Location: %s

Link /test Link /foo Link / /Link /Link in slashes/ Link foo1.save_log_server_test.tmp Link foo2.save_log_server_test.tmp Link foo3.save_log_server_test.tmp
Col1Col2Col3
A1A2A3
B1B2B3
C1C2C3

WWW-Mechanize-Shell-0.59/t/28-cmd-headers.t0000755000175000017500000000451013654075102017506 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib './inc'; use IO::Catch; our $_STDOUT_; tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; delete $ENV{PAGER} if $ENV{PAGER}; $ENV{PERL_HTML_DISPLAY_CLASS}="HTML::Display::Dump"; use Test::More tests => 8; use_ok('WWW::Mechanize::Shell'); my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); isa_ok $s, 'WWW::Mechanize::Shell'; sub cleanup() { # clean up $_STDOUT_ so it fits on one line #diag $_STDOUT_; $_STDOUT_ =~ s/[\r\n]+/|/g; $_STDOUT_ =~ s!(?<=:)(\s+)!(">" x (length($1)/2))!eg; }; SKIP: { $s->agent->{base} = 'http://example.com'; $s->agent->update_html(< An HTML page

(H1.1)

(H2)

(H3.1)

(H3.2)

(H4)

(H1.2)

(H5)

Some spaces before this

A newline in this

HTML $s->cmd('headers'); cleanup; is($_STDOUT_,"h1:(H1.1)|h2:>(H2)|h3:>>(H3.1)|h3:>>(H3.2)|h4:>>>(H4)|h1:(H1.2)|h5:>>>>(H5)|h1:|h1:Some spaces before this|h1:A newline in this|h2:>|h3:>>|", "The default works"); undef $_STDOUT_; $s->cmd('headers 12345'); cleanup; is($_STDOUT_,"h1:(H1.1)|h2:>(H2)|h3:>>(H3.1)|h3:>>(H3.2)|h4:>>>(H4)|h1:(H1.2)|h5:>>>>(H5)|h1:|h1:Some spaces before this|h1:A newline in this|h2:>|h3:>>|", "Explicitly specifying the default works as well"); undef $_STDOUT_; $s->cmd('headers 1'); cleanup; is($_STDOUT_,"h1:(H1.1)|h1:(H1.2)|h1:|h1:Some spaces before this|h1:A newline in this|", "H1 headers works as well"); undef $_STDOUT_; $s->cmd('headers 23'); cleanup; is($_STDOUT_,"h2:>(H2)|h3:>>(H3.1)|h3:>>(H3.2)|h2:>|h3:>>|", "Restricting to a subset works too"); undef $_STDOUT_; $s->cmd('headers 25'); cleanup; is($_STDOUT_,"h2:>(H2)|h5:>>>>(H5)|h2:>|", "A noncontingous subset as well"); undef $_STDOUT_; $s->cmd('headers 52'); cleanup; is($_STDOUT_,"h2:>(H2)|h5:>>>>(H5)|h2:>|", "Even in a weirdo order"); undef $_STDOUT_; }; WWW-Mechanize-Shell-0.59/t/22-complete-command.t0000755000175000017500000000121413654075102020546 0ustar corioncorion#!/usr/bin/perl -w use strict; use Test::More tests => 2; use WWW::Mechanize::Link; BEGIN { # Choose a nonannoying HTML displayer: $ENV{PERL_HTML_DISPLAY_CLASS} = 'HTML::Display::Dump'; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; use_ok('WWW::Mechanize::Shell'); }; my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); # Now test { no warnings 'redefine'; local *WWW::Mechanize::find_all_links = sub { return (WWW::Mechanize::Link->new("","foo","",""),WWW::Mechanize::Link->new("","bar","","")) }; my @comps = $s->comp_open("fo","fo",0); is_deeply(\@comps,["foo"],"Completion works"); }; WWW-Mechanize-Shell-0.59/t/26-form-no-form.t0000755000175000017500000000212013654075102017641 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib './inc'; use IO::Catch; our ($_STDOUT_, $_STDERR_); tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; tie *STDERR, 'IO::Catch', '_STDERR_' or die $!; use Test::More tests => 4; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; delete $ENV{PAGER} if $ENV{PAGER}; $ENV{PERL_HTML_DISPLAY_CLASS}="HTML::Display::Dump"; my @warnings; use_ok('WWW::Mechanize::Shell'); my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); { no warnings qw'redefine once'; *WWW::Mechanize::Shell::status = sub {}; }; $s->agent->{base} = 'http://www.google.com/'; $s->agent->update_html("No form here\n"); eval { $s->cmd("form foo"); }; is($@, '', "Can execute 'form' for a page without forms"); is($_STDOUT_,"There is no form on this page.\n","Message was printed"); is($_STDERR_,undef,"No warnings printed"); #$_STDOUT_ = undef; #$_STDERR_ = undef; #$s->cmd("save /does-not-exist/"); #is($_STDOUT_,"No match for /(?-xism:does-not-exist)/.\n","save RE error message"); #is($_STDERR_,undef,"No warnings"); WWW-Mechanize-Shell-0.59/t/02-fallback-Pod-Constant.t0000644000175000017500000000165013654075102021367 0ustar corioncorionuse strict; use Test::More tests => 4; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; SKIP: { #skip "Can't load Term::ReadKey without a terminal", 4 # unless -t STDIN; eval { require Test::Without::Module; Test::Without::Module->import('Pod::Constants') }; skip "Need Test::Without::Module to test the fallback", 4 if $@; #eval { require Term::ReadKey; Term::ReadKey::GetTerminalSize(); }; #if ($@) { # no warnings 'redefine'; # *Term::ReadKey::GetTerminalSize = sub {80,24}; # diag "Term::ReadKey seems to want a terminal"; #}; use_ok("WWW::Mechanize::Shell"); my $shell = do { WWW::Mechanize::Shell->new("shell", rcfile => undef, warnings => undef ); }; isa_ok($shell,"WWW::Mechanize::Shell"); my $text; eval { $text = $shell->catch_smry('quit'); }; is( $@, '', "No error without Pod::Constants"); is( $text, undef, "No help without Pod::Constants"); }; WWW-Mechanize-Shell-0.59/t/16-form-fillout.t0000755000175000017500000010212013654075102017742 0ustar corioncorion#!/usr/bin/perl -w use strict; use FindBin; use Test::More; use File::Temp qw( tempfile ); our ($_STDOUT_, $_STDERR_ ); use URI::URL; use Test::HTTP::LocalServer; use lib './inc'; use IO::Catch; # pre-5.8.0's warns aren't caught by a tied STDERR. $SIG{__WARN__} = sub { $main::_STDERR_ .= join '', @_; }; tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; tie *STDERR, 'IO::Catch', '_STDERR_' or die $!; our %tests = ( interactive_script_creation => { requests => 2, lines => [ 'eval @::list=qw(1 2 3 4 5 6 7 8 9 10 foo NY 11 DE 13 V 15 16 2038-01-01)', 'eval no warnings qw"once redefine"; *WWW::Mechanize::FormFiller::Value::Ask::ask_value = sub { #warn "Filled out ",$_[1]->name; my $value=shift @::list || "empty"; push @{$_[0]->{shell}->{answers}}, [ $_[1]->name, $value ]; $value }', 'get %s', 'fillout', 'submit', 'content' ], location => '%sgift_card/alphasite/www/cgi-bin/giftcard.cgi/checkout_process' }, ); plan tests => (scalar keys %tests)*6; BEGIN { delete $ENV{PAGER}; $ENV{PERL_RL} = 0; }; use WWW::Mechanize::Shell; SKIP: { # Disable all ReadLine functionality my $HTML = do { local $/; }; # We want to be safe from non-resolving local host names delete @ENV{qw(HTTP_PROXY http_proxy CGI_HTTP_PROXY)}; my $actual_requests; { no warnings 'redefine'; my $old_request = *WWW::Mechanize::request{CODE}; *WWW::Mechanize::request = sub { $actual_requests++; goto &$old_request; }; *WWW::Mechanize::Shell::status = sub {}; }; for my $name (sort keys %tests) { $_STDOUT_ = ''; undef $_STDERR_; $actual_requests = 0; my @lines = @{$tests{$name}->{lines}}; my $requests = $tests{$name}->{requests}; my $server = Test::HTTP::LocalServer->spawn( html => $HTML ); my $code_port = $server->port; my $result_location = sprintf $tests{$name}->{location}, $server->url; my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); for my $line (@lines) { no warnings; $line = sprintf $line, $server->url; $s->cmd($line); }; $s->cmd('eval $self->agent->uri'); my $code_output = $_STDOUT_; diag join( "\n", $s->history ) unless is($s->agent->uri,$result_location,"Shell moved to the specified url for $name"); is($_STDERR_,undef,"Shell produced no error output for $name"); is($actual_requests,$requests,"$requests requests were made for $name"); my $code_requests = $server->get_log; my $script_server = Test::HTTP::LocalServer->spawn(html => $HTML); my $script_port = $script_server->port; # Modify the generated Perl script to match the new? port my $script = join "\n", $s->script; s!\b$code_port\b!$script_port!smg for ($script, $code_output); undef $s; # Write the generated Perl script my ($fh,$tempname) = tempfile(); print $fh $script; close $fh; my ($compile) = `$^X -c "$tempname" 2>&1`; chomp $compile; unless (is($compile,"$tempname syntax OK","$name compiles")) { $script_server->stop; diag $script; ok(0, "Script $name didn't compile" ); ok(0, "Script $name didn't compile" ); } else { my ($output); my $command = qq($^X -Ilib "$tempname" 2>&1); $output = `$command`; $output =~ s!^Cookie:.*$!Cookie: !smg; # cookies get re-ordered, sometimes $code_output =~ s!^Cookie:.*$!Cookie: !smg; # cookies get re-ordered, sometimes is( $output, $code_output, "Output of $name is identical" ) or diag "Script:\n$script"; my $script_requests = $script_server->get_log; $code_requests =~ s!\b$code_port\b!$script_port!smg; $code_requests =~ s!^Cookie:.*$!Cookie: !smg; # cookies get re-ordered, sometimes $script_requests =~ s!^Cookie:.*$!Cookie: !smg; # cookies get re-ordered, sometimes is($code_requests,$script_requests,"$name produces identical queries") or diag $script; }; unlink $tempname or diag "Couldn't remove tempfile '$name' : $!"; }; unlink $_ for (<*.save_log_server_test.tmp>); }; __DATA__ - Gift Cards

 

Gift Card

Lorem ipsum dolor sit amet, consectetuer adipiscing elit, sed diam nonummy nibh euismod tincidunt ut laoreet dolore magna aliquam erat volutpat. Ut wisi enim ad minim veniam, quis nostrud exerci tation ullamcorper suscipit lobortis nisl ut aliquip ex ea commodo consequat. Duis autem vel eum iriure dolor in hendrerit in vulputate velit esse molestie consequat, vel illum dolore eu feugiat nulla facilisis at vero eros et accumsan et iusto odio dignissim qui blandit praesent luptatum zzril delenit augue duis dolore te feugait nulla facilisi. Lorem ipsum dolor sit amet, consectetuer adipiscing elit, sed diam nonummy nibh euismod tincidunt ut laoreet dolore magna aliquam erat volutpat. Ut wisi enim ad minim veniam, quis nostrud exerci tation ullamcorper suscipit lobortis nisl ut aliquip ex ea commodo consequat.


Delivery Information
recipient Name:
First: *
Middle:
Last: *
Nickname:
Room Number:
Card Amount:
* (i.e. $20.00)
Billing Information
First Name: *
Last Name: *
Email Address : *#
Address: *
City: *
State: *
Zip: *
Country: *
Daytime Phone: *
(i.e. (123)555-1212)
Card Type: *
Name on Card: *
Credit Card Number : *
(no spaces or dashes) i.e.1234567890121234 (use Visa and 4111111111111111 for testing)
Expiration Date: (in format: MM/YY)  *

Your credit information will be sent through a secure and encrypted channel. After submit has been selected, order cannot be changed or cancelled.

 

# Your e-mail address will be used only for receipt purposes and to contact you if there is a problem with your order and we cannot reach you by phone.

WWW-Mechanize-Shell-0.59/README.mkdn0000644000175000017500000004554513654075102016275 0ustar corioncorion [![Travis Build Status](https://travis-ci.org/Corion/WWW-Mechanize-Shell.svg?branch=master)](https://travis-ci.org/Corion/WWW-Mechanize-Shell) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/Corion/WWW-Mechanize-Shell?branch=master&svg=true)](https://ci.appveyor.com/project/Corion/WWW-Mechanize-Shell) # NAME WWW::Mechanize::Shell - An interactive shell for WWW::Mechanize # SYNOPSIS From the command line as perl -MWWW::Mechanize::Shell -eshell or alternatively as a custom shell program via : #!/usr/bin/perl -w use strict; use WWW::Mechanize::Shell; my $shell = WWW::Mechanize::Shell->new("shell"); if (@ARGV) { $shell->source_file( @ARGV ); } else { $shell->cmdloop; }; # DESCRIPTION This module implements a www-like shell above WWW::Mechanize and also has the capability to output crude Perl code that recreates the recorded session. Its main use is as an interactive starting point for automating a session through WWW::Mechanize. The cookie support is there, but no cookies are read from your existing browser sessions. See [HTTP::Cookies](https://metacpan.org/pod/HTTP::Cookies) on how to implement reading/writing your current browsers cookies. ## `WWW::Mechanize::Shell->new %ARGS` This is the constructor for a new shell instance. Some of the options can be passed to the constructor as parameters. By default, a file `.mechanizerc` (respectively `mechanizerc` under Windows) in the users home directory is executed before the interactive shell loop is entered. This can be used to set some defaults. If you want to supply a different filename for the rcfile, the `rcfile` parameter can be passed to the constructor : rcfile => '.myapprc', - **agent** my $shell = WWW::Mechanize::Shell->new( agent => WWW::Mechanize::Chrome->new(), ); Pass in a premade custom user agent. This object must be compatible to [WWW::Mechanize](https://metacpan.org/pod/WWW::Mechanize). Use this feature from the command line as perl -Ilib -MWWW::Mechanize::Chrome \ -MWWW::Mechanize::Shell \ -e"shell(agent => WWW::Mechanize::Chrome->new())" ## `$shell->release_agent` Since the shell stores a reference back to itself within the WWW::Mechanize instance, it is necessary to break this circular reference. This method does this. ## `$shell->source_file FILENAME` The `source_file` method executes the lines of FILENAME as if they were typed in. $shell->source_file( $filename ); ## `$shell->display_user_warning` All user warnings are routed through this routine so they can be rerouted / disabled easily. ## `$shell->print_paged LIST` Prints the text in LIST using `$ENV{PAGER}`. If `$ENV{PAGER}` is empty, prints directly to `STDOUT`. Most of this routine comes from the `perldoc` utility. ## `$shell->link_text LINK` Returns a meaningful text from a WWW::Mechanize::Link object. This is (in order of precedence) : $link->text $link->name $link->url ## `$shell->history` Returns the (relevant) shell history, that is, all commands that were not solely for the information of the user. The lines are returned as a list. print join "\n", $shell->history; ## `$shell->script` Returns the shell history as a Perl program. The lines are returned as a list. The lines do not have a one-by-one correspondence to the lines in the history. print join "\n", $shell->script; ## `$shell->status` `status` is called for status updates. ## `$shell->display FILENAME LINES` `display` is called to output listings, currently from the `history` and `script` commands. If the second parameter is defined, it is the name of the file to be written, otherwise the lines are displayed to the user. # COMMANDS The shell implements various commands : ## exit Leaves the shell. ## restart Restart the shell. This is mostly useful when you are modifying the shell itself. It dosen't work if you use the shell in oneliner mode with `-e`. ## get Download a specific URL. This is used as the entry point in all sessions Syntax: get URL ## save Download a link into a file. If more than one link matches the RE, all matching links are saved. The filename is taken from the last part of the URL. Alternatively, the number of a link may also be given. Syntax: save RE ## content Display the content for the current page. Syntax: content \[FILENAME\] If the FILENAME argument is provided, save the content to the file. A trailing "\\n" is added to the end of the content when using the shell, so this might not be ideally suited to save binary files without manual editing of the produced script. ## title Display the current page title as found in the `` tag. ## headers Prints all `<H1>` through `<H5>` strings found in the content, indented accordingly. With an argument, prints only those levels; e.g., `headers 145` prints H1,H4,H5 strings only. ## ua Get/set the current user agent Syntax: # fake Internet Explorer ua "Mozilla/4.0 (compatible; MSIE 4.01; Windows 98)" # fake QuickTime v5 ua "QuickTime (qtver=5.0.2;os=Windows NT 5.0Service Pack 2)" # fake Mozilla/Gecko based ua "Mozilla/5.001 (windows; U; NT4.0; en-us) Gecko/25250101" # set empty user agent : ua "" ## links Display all links on a page The links numbers displayed can used by `open` to directly select a link to follow. ## images Display images on a page ## parse Dump the output of HTML::TokeParser of the current content ## forms Display all forms on the current page. ## form Select the form named NAME If NAME matches `/^\d+$/`, it is assumed to be the (1-based) index of the form to select. There is no way of selecting a numerically named form by its name. ## dump Dump the values of the current form ## value Set a form value Syntax: value NAME [VALUE] ## tick Set checkbox marks Syntax: tick NAME VALUE(s) If no value is given, all boxes are checked. ## untick Remove checkbox marks Syntax: untick NAME VALUE(s) If no value is given, all marks are removed. ## submit submits the form without clicking on any button ## click Clicks on the button named NAME. No regular expression expansion is done on NAME. Syntax: click NAME If you have a button that has no name (displayed as NONAME), use click "" to click on it. ## open <open> accepts one argument, which can be a regular expression or the number of a link on the page, starting at zero. These numbers are displayed by the `links` function. It goes directly to the page if a number is used or if the RE has one match. Otherwise, a list of links matching the regular expression is displayed. The regular expression should start and end with "/". Syntax: open [ RE | # ] ## back Go back one page in the browser page history. ## reload Repeat the last request, thus reloading the current page. Note that also POST requests are blindly repeated, as this command is mostly intended to be used when testing server side code. ## browse Open the web browser with the current page Displays the current page in the browser. ## set Set a shell option Syntax: set OPTION [value] The command lists all valid options. Here is a short overview over the different options available : autosync - automatically synchronize the browser window autorestart - restart the shell when any required module changes This does not work with C<-e> oneliners. watchfiles - watch all required modules for changes cookiefile - the file where to store all cookies dumprequests - dump all requests to STDOUT dumpresponses - dump the headers of the responses to STDOUT verbose - print commands to STDERR as they are run, when sourcing from a file ## history Display your current session history as the relevant commands. Syntax: history [FILENAME] Commands that have no influence on the browser state are not added to the history. If a parameter is given to the `history` command, the history is saved to that file instead of displayed onscreen. ## script Display your current session history as a Perl script using WWW::Mechanize. Syntax: script [FILENAME] If a parameter is given to the `script` command, the script is saved to that file instead of displayed on the console. This command was formerly known as `history`. ## comment Adds a comment to the script and the history. The comment is prepended with a \\n to increase readability. ## fillout Fill out the current form Interactively asks the values hat have no preset value via the autofill command. ## auth Set basic authentication credentials. Syntax: auth user password If you know the authority and the realm in advance, you can presupply the credentials, for example at the start of the script : >auth corion secret >get http://www.example.com Retrieving http://www.example.com(200) http://www.example.com> ## table Display a table described by the columns COLUMNS. Syntax: table COLUMNS Example: table Product Price Description If there is a table on the current page that has in its first row the three columns `Product`, `Price` and `Description` (not necessarily in that order), the script will display these columns of the whole table. The `HTML::TableExtract` module is needed for this feature. ## tables Display a list of tables. Syntax: tables This command will display the top row for every table on the current page. This is convenient if you want to find out what the exact spellings for each column are. The command does not always work nice, for example if a site uses tables for layout, it will be harder to guess what tables are irrelevant and what tables are relevant. [HTML::TableExtract](https://metacpan.org/pod/HTML::TableExtract) is needed for this feature. ## cookies Set the cookie file name Syntax: cookies FILENAME ## autofill Define an automatic value Sets a form value to be filled automatically. The NAME parameter is the WWW::Mechanize::FormFiller::Value subclass you want to use. For session fields, `Keep` is a good candidate, for interactive stuff, `Ask` is a value implemented by the shell. A field name starting and ending with a slash (`/`) is taken to be a regular expression and will be applied to all fields with their name matching the expression. A field with a matching name still takes precedence over the regular expression. Syntax: autofill NAME [PARAMETERS] Examples: autofill login Fixed corion autofill password Ask autofill selection Random red green orange autofill session Keep autofill "/date$/" Random::Date string "%m/%d/%Y" ## eval Evaluate Perl code and print the result Syntax: eval CODE For the generated scripts, anything matching the regular expression `/\$self->agent\b/` is automatically replaced by `$agent` in your eval code, to do the Right Thing. Examples: # Say hello eval "Hello World" # And take a look at the current content type eval $self->agent->ct ## source Execute a batch of commands from a file Syntax: source FILENAME ## versions Print the version numbers of important modules Syntax: versions ## timeout Set new timeout value for the agent. Effects all subsequent requests. VALUE is in seconds. Syntax: timeout VALUE ## ct prints the content type of the most current response. Syntax: ct ## referrer set the value of the Referer: header Syntax: referer URL referrer URL ## referer Alias for referrer ## response display the last server response ## `$shell->munge_code( CODE )` Munges a coderef to become code fit for output independent of WWW::Mechanize::Shell. ## `shell` This subroutine is exported by default as a convenience method so that the following oneliner invocation works: perl -MWWW::Mechanize::Shell -eshell You can pass constructor arguments to this routine as well. Any scripts given in `@ARGV` will be run. If `@ARGV` is empty, an interactive loop will be started. # SAMPLE SESSIONS ## Entering values # Search for a term on Google get http://www.google.com value q "Corions Homepage" click btnG script # (yes, this is a bad example of automating, as Google # already has a Perl API. But other sites don't) ## Retrieving a table get http://www.perlmonks.org open "/Saints in/" table User Experience Level script # now you have a program that gives you a csv file of # that table. ## Uploading a file get http://aliens:xxxxx/ value f path/to/file click "upload" ## Batch download # download prerelease versions of my modules get http://www.corion.net/perl-dev save /.tar.gz$/ # REGULAR EXPRESSION SYNTAX Some commands take regular expressions as parameters. A regular expression **must** be a single parameter matching `^/.*/([isxm]+)?$`, so you have to use quotes around it if the expression contains spaces : /link_foo/ # will match as (?-xims:link_foo) "/link foo/" # will match as (?-xims:link foo) Slashes do not need to be escaped, as the shell knows that a RE starts and ends with a slash : /link/foo/ # will match as (?-xims:link/foo) "/link/ /foo/" # will match as (?-xims:link/\s/foo) The `/i` modifier works as expected. If you desire more power over the regular expressions, consider dropping to Perl or recommend me a good parser module for regular expressions. # DISPLAYING HTML WWW::Mechanize::Shell now uses the module HTML::Display to display the HTML of the current page in your browser. Have a look at the documentation of HTML::Display how to make it use your browser of choice in the case it does not already guess it correctly. # FILLING FORMS VIA CUSTOM CODE If you want to stay within the confines of the shell, but still want to fill out forms using custom Perl code, here is a recipe how to achieve this : Code passed to the `eval` command gets evalutated in the WWW::Mechanize::Shell namespace. You can inject new subroutines there and these get picked up by the Callback class of WWW::Mechanize::FormFiller : # Fill in the "date" field with the current date/time as string eval sub &::custom_today { scalar localtime }; autofill date Callback WWW::Mechanize::Shell::custom_today fillout This method can also be used to retrieve data from shell scripts : # Fill in the "date" field with the current date/time as string # works only if there is a program "date" eval sub &::custom_today { chomp `date` }; autofill date Callback WWW::Mechanize::Shell::custom_today fillout As the namespace is different between the shell and the generated script, make sure you always fully qualify your subroutine names, either in your own namespace or in the main namespace. # GENERATED SCRIPTS The `script` command outputs a skeleton script that reproduces your actions as done in the current session. It pulls in `WWW::Mechanize::FormFiller`, which is possibly not needed. You should add some error and connection checking afterwards. # ADDING FIELDS TO HTML If you are automating a JavaScript dependent site, you will encounter JavaScript like this : <script> document.write( "<input type=submit name=submit>" ); </script> HTML::Form will not know about this and will not have provided a submit button for you (understandably). If you want to create such a submit button from within your automation script, use the following code : $agent->current_form->push_input( submit => { name => "submit", value =>"submit" } ); This also works for other dynamically generated input fields. To fake an input field from within a shell session, use the `eval` command : eval $self->agent->current_form->push_input(submit=>{name=>"submit",value=>"submit"}); And yes, the generated script should do the Right Thing for this eval as well. # LOCAL FILES If you want to use the shell on a local file without setting up a `http` server to serve the file, you can use the `file:` URI scheme to load it into the "browser": get file:local.html forms # PROXY SUPPORT Currently, the proxy support is realized via a call to the `env_proxy` method of the WWW::Mechanize object, which loads the proxies from the environment. There is no provision made to prevent using proxies (yet). The generated scripts also load their proxies from the environment. # ONLINE HELP The online help feature is currently a bit broken in `Term::Shell`, but a fix is in the works. Until then, you can re-enable the dynamic online help by patching `Term::Shell` : Remove the three lines my $smry = exists $o->{handlers}{$h}{smry} ? $o->summary($h) : "undocumented"; in `sub run_help` and replace them by my $smry = $o->summary($h); The shell works without this patch and the online help is still available through `perldoc WWW::Mechanize::Shell` # BUGS Bug reports are very welcome - please use the RT interface at https://rt.cpan.org/NoAuth/Bugs.html?Dist=WWW-Mechanize-Shell or send a descriptive mail to bug-WWW-Mechanize-Shell@rt.cpan.org . Please try to include as much (relevant) information as possible - a test script that replicates the undesired behaviour is welcome every time! - The two parameter version of the `auth` command guesses the realm from the last received response. Currently a RE is used to extract the realm, but this fails with some servers resp. in some cases. Use the four parameter version of `auth`, or if not possible, code the extraction in Perl, either in the final script or through `eval` commands. - The shell currently detects when you want to follow a JavaScript link and tells you that this is not supported. It would be nicer if there was some callback mechanism to (automatically?) extract URLs from JavaScript-infected links. # TODO - Add XPath expressions (by moving `WWW::Mechanize` from HTML::Parser to XML::XMLlib or maybe easier, by tacking Class::XPath onto an HTML tree) - Add `head` as a command ? - Optionally silence the HTML::Parser / HTML::Forms warnings about invalid HTML. # EXPORT The routine `shell` is exported into the importing namespace. This is mainly for convenience so you can use the following commandline invocation of the shell like with CPAN : perl -MWWW::Mechanize::Shell -e"shell" # REPOSITORY The public repository of this module is [https://github.com/Corion/WWW-Mechanize-Shell](https://github.com/Corion/WWW-Mechanize-Shell). # SUPPORT The public support forum of this module is [http://perlmonks.org/](http://perlmonks.org/). # COPYRIGHT AND LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Copyright (C) 2002-2020 Max Maischein # AUTHOR Max Maischein, <corion@cpan.org> Please contact me if you find bugs or otherwise improve the module. More tests are also very welcome ! # SEE ALSO [WWW::Mechanize](https://metacpan.org/pod/WWW::Mechanize),[WWW::Mechanize::FormFiller](https://metacpan.org/pod/WWW::Mechanize::FormFiller),[WWW::Mechanize::Firefox](https://metacpan.org/pod/WWW::Mechanize::Firefox) �����������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/.gitignore�����������������������������������������������������������������0000644�0001750�0001750�00000000241�13654075102�016435� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Makefile Makefile.old *.tar.gz *.bak *.swp pm_to_blib blib/ WWW-Mechanize-Shell-* WWW-Mechanize-Shell-*/ .lwpcookies .releaserc MYMETA.* *.pl .prove .patch CVS/ ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/META.yml�������������������������������������������������������������������0000644�0001750�0001750�00000002150�13654075103�015720� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������--- abstract: 'An interactive shell for WWW::Mechanize' author: - 'Max Maischein <corion@cpan.org>' build_requires: CGI: '0' ExtUtils::MakeMaker: '0' File::Temp: '0' Test::HTTP::LocalServer: '0.68' Test::More: '0' Test::Without::Module: '0' URI: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 7.1002, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: WWW-Mechanize-Shell no_index: directory: - t - inc requires: HTML::Display: '0' HTML::TokeParser::Simple: '2' HTTP::Cookies: '0' Hook::LexWrap: '0.2' LWP: '5.69' LWP::UserAgent: '0' Term::Shell: '0.02' Test::Harness: '2.3' URI::URL: '0' WWW::Mechanize: '1.2' WWW::Mechanize::FormFiller: '0.05' WWW::Mechanize::Link: '1.2' parent: '0' perl: '5.006' resources: license: https://dev.perl.org/licenses/ repository: git://github.com/Corion/WWW-Mechanize-Shell.git version: '0.59' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' x_static_install: 1 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/lib/�����������������������������������������������������������������������0000755�0001750�0001750�00000000000�13654075103�015217� 5����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/lib/WWW/�������������������������������������������������������������������0000755�0001750�0001750�00000000000�13654075103�015703� 5����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/lib/WWW/Mechanize/���������������������������������������������������������0000755�0001750�0001750�00000000000�13654075103�017606� 5����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/lib/WWW/Mechanize/Shell.pm�������������������������������������������������0000644�0001750�0001750�00000142300�13654075102�021212� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package WWW::Mechanize::Shell; use strict; use Carp; use WWW::Mechanize; use WWW::Mechanize::FormFiller; use HTTP::Cookies; use parent qw( Term::Shell ); use Exporter 'import'; use FindBin; use File::Temp qw(tempfile); use URI::URL; use Hook::LexWrap; use HTML::Display qw(); use HTML::TokeParser::Simple; use B::Deparse; our $VERSION = '0.59'; our @EXPORT = qw( &shell ); =head1 NAME WWW::Mechanize::Shell - An interactive shell for WWW::Mechanize =head1 SYNOPSIS From the command line as perl -MWWW::Mechanize::Shell -eshell or alternatively as a custom shell program via : =for example begin #!/usr/bin/perl -w use strict; use WWW::Mechanize::Shell; my $shell = WWW::Mechanize::Shell->new("shell"); if (@ARGV) { $shell->source_file( @ARGV ); } else { $shell->cmdloop; }; =for example end =for example_testing BEGIN { require WWW::Mechanize::Shell; $ENV{PERL_RL} = 0; $ENV{COLUMNS} = '80'; $ENV{LINES} = '24'; }; BEGIN { no warnings 'once'; no warnings 'redefine'; *WWW::Mechanize::Shell::cmdloop = sub {}; *WWW::Mechanize::Shell::display_user_warning = sub {}; *WWW::Mechanize::Shell::source_file = sub {}; }; isa_ok( $shell, "WWW::Mechanize::Shell" ); =head1 DESCRIPTION This module implements a www-like shell above WWW::Mechanize and also has the capability to output crude Perl code that recreates the recorded session. Its main use is as an interactive starting point for automating a session through WWW::Mechanize. The cookie support is there, but no cookies are read from your existing browser sessions. See L<HTTP::Cookies> on how to implement reading/writing your current browsers cookies. =head2 C<WWW::Mechanize::Shell-E<gt>new %ARGS> This is the constructor for a new shell instance. Some of the options can be passed to the constructor as parameters. By default, a file C<.mechanizerc> (respectively C<mechanizerc> under Windows) in the users home directory is executed before the interactive shell loop is entered. This can be used to set some defaults. If you want to supply a different filename for the rcfile, the C<rcfile> parameter can be passed to the constructor : rcfile => '.myapprc', =over 4 =item B<agent> my $shell = WWW::Mechanize::Shell->new( agent => WWW::Mechanize::Chrome->new(), ); Pass in a premade custom user agent. This object must be compatible to L<WWW::Mechanize>. Use this feature from the command line as perl -Ilib -MWWW::Mechanize::Chrome \ -MWWW::Mechanize::Shell \ -e"shell(agent => WWW::Mechanize::Chrome->new())" =back =cut sub init { my ($self) = @_; my ($name,%args) = @{$self->{API}{args}}; $self->{agent} = $args{ agent }; if( ! $self->agent ) { my $class = $args{ agent_class } || 'WWW::Mechanize'; my $args = $args{ agent_args } || []; $self->{agent} = $class->new( @$args ); }; $self->{formfiller} = WWW::Mechanize::FormFiller->new(default => [ Ask => $self ]); $self->{history} = []; $self->{options} = { autosync => 0, warnings => (exists $args{warnings} ? $args{warnings} : 1), autorestart => 0, watchfiles => (exists $args{watchfiles} ? $args{watchfiles} : 1), cookiefile => 'cookies.txt', dumprequests => 0, dumpresponses => 0, verbose => 0, }; # Install the request dumper : $self->{request_wrapper} = wrap 'LWP::UserAgent::request', #pre => sub { printf STDERR "Dumping? %s\n",$self->option("dumprequests"); $self->request_dumper($_[1]) if $self->option("dumprequests"); }, pre => sub { $self->request_dumper($_[1]) if $self->option("dumprequests"); }, post => sub { $self->response_dumper($_[-1]) if $self->option("dumpresponses"); }; $self->{redirect_ok_wrapper} = wrap 'WWW::Mechanize::redirect_ok', post => sub { return unless $_[1]; $self->status( "\nRedirecting to ".$_[1]->uri."\n" ); $_[-1] }; # Load the proxy settings from the environment $self->agent->env_proxy() if $self->agent->can('env_proxy'); # Read our .rc file : # I could use File::Homedir, but the docs claim it dosen't work on Win32. Maybe # I should just release a patch for File::Homedir then... Not now. my $sourcefile; if (exists $args{rcfile}) { $sourcefile = delete $args{rcfile}; } else { my $userhome = $^O =~ /win32/i ? $ENV{'USERPROFILE'} || $ENV{'HOME'} : ((getpwuid($<))[7]); $sourcefile = "$userhome/.mechanizerc" if -f "$userhome/.mechanizerc"; }; $self->option('cookiefile', $args{cookiefile}) if (exists $args{cookiefile}); $self->source_file($sourcefile) if defined $sourcefile; $self->{browser} = undef; # Keep track of the files we consist of, to enable automatic reloading $self->{files} = undef; if ($self->option('watchfiles')) { eval { my @files = grep { -f && -r && $_ ne '-e' } values %INC; local $, = ","; require File::Modified; $self->{files} = File::Modified->new(files=>[@files]); }; $self->display_user_warning( "Module File::Modified not found. Automatic reloading disabled.\n" ) if ($@); }; }; =head2 C<$shell-E<gt>release_agent> Since the shell stores a reference back to itself within the WWW::Mechanize instance, it is necessary to break this circular reference. This method does this. =cut sub release_agent { my ($self) = @_; use Data::Dumper; warn Dumper $self; undef $self->{request_wrapper}; undef $self->{redirect_ok_wrapper}; $self->{agent} = undef; }; =head2 C<$shell-E<gt>source_file FILENAME> The C<source_file> method executes the lines of FILENAME as if they were typed in. $shell->source_file( $filename ); =cut sub source_file { my ($self,$filename) = @_; local $_; # just to be on the safe side that we don't clobber outside users of $_ local *F; open F, "< $filename" or die "Couldn't open '$filename' : $!\n"; while (<F>) { $self->cmd($_); warn "cmd: $_" if $self->{options}->{verbose}; }; close F; }; sub add_history { my ($self,@code) = @_; push @{$self->{history}},[$self->line,join "",@code]; }; =head2 C<$shell-E<gt>display_user_warning> All user warnings are routed through this routine so they can be rerouted / disabled easily. =cut sub display_user_warning { my ($self,@message) = @_; warn @message if $self->option('warnings'); }; =head2 C<$shell-E<gt>print_paged LIST> Prints the text in LIST using C<$ENV{PAGER}>. If C<$ENV{PAGER}> is empty, prints directly to C<STDOUT>. Most of this routine comes from the C<perldoc> utility. =cut sub print_paged { my $self = shift; if ($ENV{PAGER} and -t STDOUT) { my ($fh,$filename) = tempfile(); print $fh $_ for @_; close $fh; my @pagers = ($ENV{PAGER},qq{"$^X" -p}); foreach my $pager (@pagers) { if ($^O eq 'VMS') { last if system("$pager $filename") == 0; # quoting prevents logical expansion } else { last if system(qq{$pager "$filename"}) == 0; } }; unlink $filename or $self->display_user_warning("Couldn't unlink tempfile $filename : $!\n"); } else { print $_ for @_; }; }; sub agent { $_[0]->{agent}; }; sub option { my ($self,$option,$value) = @_; if (exists $self->{options}->{$option}) { my $result = $self->{options}->{$option}; if (scalar @_ == 3) { $self->{options}->{$option} = $value; }; $result; } else { Carp::carp "Unknown option '$option'"; undef; }; }; sub restart_shell { if ($0 ne '-e') { print "Restarting $0\n"; exec $^X, $0, @ARGV; }; }; sub precmd { my $self = shift @_; # We want to restart when any module was changed if ($self->{files} and $self->{files}->changed()) { print "One or more of the base files were changed\n"; $self->restart_shell if ($self->option('autorestart')); }; $self->SUPER::precmd(@_); }; sub browser { my ($self) = @_; $self->{browser} ||= HTML::Display->new(); $self->{browser}; }; sub sync_browser { my ($self) = @_; # We only can display html if we have any : return unless $self->agent->res; # Prepare the HTML for local display : my $unclean = $self->agent->content; my $html = ''; # ugly fix: # strip all target='_blank' attributes from the HTML: my $p = HTML::TokeParser::Simple->new(\$unclean); while (my $token = $p->get_token) { $token->delete_attr('target') if $token->is_start_tag; $html .= $token->as_is; }; my $location = $self->agent->{uri}; my $browser = $self->browser; $browser->display( html => $html, location => $location ); }; sub prompt_str { my $self = shift; if ($self->agent->response) { return ($self->agent->uri || "") . ">" } else { return "(no url)>" }; }; sub request_dumper { print $_[1]->as_string }; sub response_dumper { if (ref $_[1] eq 'ARRAY') { print $_[1]->[0]->as_string; } else { print $_[1]->as_string; } }; sub re_or_string { my ($self,$arg) = @_; if ($arg =~ m!^/(.*)/([imsx]*)$!) { my ($re,$mode) = ($1,$2); $re =~ s!([^\\])/!$1\\/!g; $arg = eval "qr/$re/$mode"; }; $arg; }; =head2 C<< $shell->link_text LINK >> Returns a meaningful text from a WWW::Mechanize::Link object. This is (in order of precedence) : $link->text $link->name $link->url =cut sub link_text { my ($self,$link) = @_; my $result; for (qw( text name url )) { $result = $link->$_ and last; }; $result; }; =head2 C<$shell-E<gt>history> Returns the (relevant) shell history, that is, all commands that were not solely for the information of the user. The lines are returned as a list. print join "\n", $shell->history; =cut sub history { my ($self) = @_; map { $_->[0] } @{$self->{history}} }; =head2 C<$shell-E<gt>script> Returns the shell history as a Perl program. The lines are returned as a list. The lines do not have a one-by-one correspondence to the lines in the history. print join "\n", $shell->script; =cut sub script { my ($self,$prefix) = @_; $prefix ||= ""; my @result = sprintf <<'HEADER', $^X; #!%s -w use strict; use WWW::Mechanize; use WWW::Mechanize::FormFiller; use URI::URL; my $agent = WWW::Mechanize->new( autocheck => 1 ); my $formfiller = WWW::Mechanize::FormFiller->new(); $agent->env_proxy(); HEADER push @result, map { my $x = $_->[1]; $x =~ s/^/$prefix/mg; $x } @{$self->{history}}; @result; }; =head2 C<$shell-E<gt>status> C<status> is called for status updates. =cut sub status { my $self = shift; print join "", @_; }; =head2 C<$shell-E<gt>display FILENAME LINES> C<display> is called to output listings, currently from the C<history> and C<script> commands. If the second parameter is defined, it is the name of the file to be written, otherwise the lines are displayed to the user. =cut sub display { my ($self,$filename,@lines) = @_; if (defined $filename) { eval { open my $f, ">", $filename or die "Couldn't create $filename : $!"; binmode $f; print $f join( "", map { "$_\n" } (@lines) ); close $f; }; warn $@ if $@; } else { $self->print_paged( join( "", map { "$_\n" } (@lines) )); }; }; # sub-classed from Term::Shell to handle all run_ requests that have no corresponding sub # This is used for comments sub catch_run { my ($self) = shift; my ($command) = @_; if ($command =~ /^\s*#/) { # Hey, it's a comment. } else { print $self->msg_unknown_cmd($command); }; }; # sub-classed from Term::Shell to handle all smry requests sub catch_smry { my ($self,$command) = @_; my $result = eval { require Pod::Constants; my @summary; my $module = (ref $self ).".pm"; $module =~ s!::!/!g; $module = $INC{$module}; Pod::Constants::import_from_file( $module, $command => \@summary ); $summary[0]; }; if ($@) { return undef; }; return $result; }; # sub-classed from Term::Shell to handle all help requests sub catch_help { my ($self,$command) = @_; my @result = eval { require Pod::Constants; my @summary; my $module = (ref $self ).".pm"; $module =~ s!::!/!g; $module = $INC{$module}; Pod::Constants::import_from_file( $module, $command => \@summary ); @summary; }; if ($@) { my $module = ref $self; $self->display_user_warning( "Pod::Constants not available. Use perldoc $module for help.\n" ); return undef; }; return join( "\n", @result) . "\n"; }; =head1 COMMANDS The shell implements various commands : =head2 exit Leaves the shell. =cut sub alias_exit { qw(quit) }; =head2 restart Restart the shell. This is mostly useful when you are modifying the shell itself. It dosen't work if you use the shell in oneliner mode with C<-e>. =cut sub run_restart { my ($self) = @_; $self->restart_shell; }; sub activate_first_form { $_[0]->agent->form_number(1) if $_[0]->agent->forms and scalar @{$_[0]->agent->forms}; }; =head2 get Download a specific URL. This is used as the entry point in all sessions Syntax: get URL =cut sub run_get { my ($self,$url) = @_; $self->status( "Retrieving $url" ); my $code; eval { $self->agent->get($url) }; if ($@) { print "\n$@\n" if $@; $self->agent->back; } else { $code = $self->agent->res->code; $self->status( "($code)\n" ); }; $self->activate_first_form; $self->sync_browser if $self->option('autosync'); $self->add_history( sprintf q{$agent->get('%s');}."\n".q{ $agent->form_number(1) if $agent->forms and scalar @{$agent->forms};}, $url); }; =head2 save Download a link into a file. If more than one link matches the RE, all matching links are saved. The filename is taken from the last part of the URL. Alternatively, the number of a link may also be given. Syntax: save RE =cut sub run_save { my ($self,$user_link) = @_; unless (defined $user_link) { print "No link given to save\n"; return }; my @history; my @links = (); my @all_links = $self->agent->links; push @history, q{my @links;} . "\n"; push @history, q{my @all_links = $agent->links();} . "\n"; $user_link = $self->re_or_string($user_link); if (ref $user_link) { my $count = -1; my $re = $user_link; @links = map { $count++; ((defined $_->text && $_->text =~ /$re/)||(defined $_->url && $_->url =~ /$re/)) ? $count : () } @all_links; if (@links == 0) { print "No match for /$re/.\n"; }; push @history, q{my $count = -1;} . "\n"; push @history, sprintf q{@links = map { $count++; ((defined $_->text && $_->text =~ qr(%s))||(defined $_->url && $_->url =~ qr(%s))) ? $count : () } @all_links;} . "\n", $re, $re; } else { @links = $user_link; push @history, sprintf q{@links = '%s';} . "\n", $user_link; }; if (@links) { $self->add_history( @history,<<'CODE' ); my $base = $agent->uri; for my $link (@links) { my $target = $all_links[$link]->url; my $url = URI::URL->new($target,$base); $target = $url->path; $target =~ s!^(.*/)?([^/]+)$!$2!; $url = $url->abs; # use this line instead of the next in case you want to use smart mirroring #$agent->mirror($url,$target); $agent->get( $url, ':content_file' => $target ); }; CODE my $base = $self->agent->uri; for my $link (@links) { my $target = $all_links[$link]->url; my $url = URI::URL->new($target,$base); $target = $url->path; $target =~ s!^(.*/)?([^/]+)$!$2!; $url = $url->abs; eval { $self->status( "$url => $target" ); $self->agent->get( $url, ':content_file' => $target ); }; warn $@ if $@; }; } }; =head2 content Display the content for the current page. Syntax: content [FILENAME] If the FILENAME argument is provided, save the content to the file. A trailing "\n" is added to the end of the content when using the shell, so this might not be ideally suited to save binary files without manual editing of the produced script. =cut sub run_content { my ($self, $filename) = @_; $self->display($filename, $self->agent->content); if ($filename) { $self->add_history( sprintf '{ my $filename = q{%s}; local *F; open F, "> $filename" or die "$filename: $!"; binmode F; print F $agent->content,"\n"; close F };', $filename ); } else { $self->add_history('print $agent->content,"\n";'); }; }; =head2 title Display the current page title as found in the C<< <TITLE> >> tag. =cut sub run_title { my ($self) = @_; my $title = $self->agent->title; if (! defined $title) { $title = "<missing title>" } elsif ($title eq '') { $title = "<empty title>" }; print "$title\n"; }; =head2 headers Prints all C<< <H1> >> through C<< <H5> >> strings found in the content, indented accordingly. With an argument, prints only those levels; e.g., C<headers 145> prints H1,H4,H5 strings only. =cut sub run_headers { my ($self,$headers) = @_; $headers ||= "12345"; my $content = $self->agent->content; # Convert the $headers argument to a RE matching # the header tags: my $wanted = join "|", map { "H$_" } split //, $headers; $wanted = qr/^$wanted$/i; #warn $wanted; my $p = HTML::TokeParser::Simple->new( \$content ); while ( my $token = $p->get_token ) { # This prints all text in an HTML doc (i.e., it strips the HTML) if ($token->is_start_tag($wanted)) { my $tag = $token->get_tag; # Indent with two spaces per level my $indent; $indent = $1 if ($tag =~ /(\d)/); $indent ||= 1; $indent--; $indent *= 2; # advance and print the first text tag we encounter while ($token and not $token->is_text and not $token->is_end_tag($wanted)) { $token = $p->get_token }; my $text = "<no text>"; if ($token and $token->is_text) { $text = $token->as_is; if ($text !~ /\S/) { $text = "<empty tag>"; }; }; # Clean up whitespace $text =~ s/^\s+//g; $text =~ s/\s+$//g; $text =~ s/\s+/ /g; printf "%s:%${indent}s%s\n", $tag, "", $text; }; } }; =head2 ua Get/set the current user agent Syntax: # fake Internet Explorer ua "Mozilla/4.0 (compatible; MSIE 4.01; Windows 98)" # fake QuickTime v5 ua "QuickTime (qtver=5.0.2;os=Windows NT 5.0Service Pack 2)" # fake Mozilla/Gecko based ua "Mozilla/5.001 (windows; U; NT4.0; en-us) Gecko/25250101" # set empty user agent : ua "" =cut sub run_ua { my ($self,$ua) = @_; my ($result) = $self->agent->agent; if (scalar @_ == 2) { $self->agent->agent($ua); $self->add_history( sprintf q{$agent->agent('%s');}, $ua); } else { print "Current user agent: $result\n"; }; }; =head2 links Display all links on a page The links numbers displayed can used by C<open> to directly select a link to follow. =cut sub run_links { my ($self) = @_; my @links = $self->agent->links; my $count = 0; for my $link (@links) { # print "[", $count++, "] ", $link->[1],"\n"; print sprintf "[%s] %s\n", $count++, $self->link_text($link); }; }; =head2 images Display images on a page =cut sub run_images { my ($self) = @_; my @images = $self->agent->images; my $count = 0; for my $image ( @images ) { print sprintf("[%d] \"%s\" %s\n", $count++, $image->alt, $image->url); } } =head2 parse Dump the output of HTML::TokeParser of the current content =cut sub run_parse { my ($self) = @_; my $content = $self->agent->content; my $p = HTML::TokeParser->new(\$content); #$p->report_tags(qw(form input textarea select optgroup option)); while (my $token = $p->get_token()) { #while (my $token = $p->get_tag("frame")) { # print "<",$token->[0],":",ref $token->[1] ? $token->[1]->{src} : "",">"; print "<",$token->[0],":",$token->[1],">"; } }; =head2 forms Display all forms on the current page. =cut sub run_forms { my ($self,$number) = @_; my $count = 1; my $agent = $self->agent; my @forms = $agent->forms; if (@forms) { for (@forms) { print "Form [",$count++,"]\n"; $_->dump; }; } else { print "No forms on current page.\n"; }; }; =head2 form Select the form named NAME If NAME matches C</^\d+$/>, it is assumed to be the (1-based) index of the form to select. There is no way of selecting a numerically named form by its name. =cut sub run_form { my ($self,$name) = @_; my $number; unless ($self->agent->current_form) { print "There is no form on this page.\n"; return; }; if ($name) { my ($method,$val); $val = $name; if ($name =~ /^\d+$/) { $method = 'form_number'; } else { $method = 'form_name'; $val = qq{'$name'}; }; eval { $self->agent->$method($name); $self->add_history(sprintf q{$agent->%s(%s);}, $method, $val); $self->status($self->agent->current_form->dump); }; $self->display_user_warning( $@ ) if ($@); } else { my $count = 1; my @forms = $self->agent->forms; if (@forms) { for my $form (@forms) { print sprintf "Form [%s] (%s)\n", $count++, ($form->attr('name') || "<no name>"); $form->dump; }; } else { print "No forms found on the current page.\n"; }; }; }; =head2 dump Dump the values of the current form =cut sub run_dump { my ($self) = @_; my $form = $self->agent->current_form; if ($form) { $form->dump } else { warn "There is no form on the current page\n" if $self->option('warnings'); }; }; =head2 value Set a form value Syntax: value NAME [VALUE] =cut sub run_value { my ($self,$key,@values) = @_; # dwim on @values my $value = join " ", @values; # Look if we are filling a checkbox set: #my $field = $self->agent->current_form->find_input($key); #if ($field and ($field->type eq 'checkbox')) { # # We want to explicitly multiple checkboxes. This means we # # have to clear all checkboxes and then set them explicitly. # # for my $value (@values) { # # Blatantly stolen from WWW::Mechanize::Ticky by # # Mark Fowler E<lt>mark@twoshortplanks.comE<gt> # my $input; # my $index = 0; # INPUT: while($input = $self->agent->current_form->find_input($name,"checkbox",$index)) { # # can't guarentee that the first element will be undef and the second # # element will be the right name # foreach my $val ($input->possible_values()) { # next unless defined $val; # if ($val eq $value) { # $input->value($set ? $value : undef); # last INPUT; # } # } # # # move onto the next input # $index++; # } # }; #}; eval { local $^W; $self->agent->current_form->value($key,$value); # Hmm - neither $key nor $value may contain backslashes nor single quotes ... $self->add_history( sprintf q{{ local $^W; $agent->current_form->value('%s', '%s'); };}, $key, $value); }; warn $@ if $@; }; =head2 tick Set checkbox marks Syntax: tick NAME VALUE(s) If no value is given, all boxes are checked. =cut sub tick { my ($self,$tick,$key,@values) = @_; eval { local $^W; for my $value (@values) { $self->agent->$tick($key,$value); }; # Hmm - neither $key nor $value may contain backslashes nor single quotes ... my $value_str = join ", ", map {qq{'$_'}} @values; $self->add_history( sprintf q{{ local $^W; for (%s) { $agent->%s('%s', $_); };}}, $value_str, $tick, $key); }; warn $@ if $@; }; sub tick_all { my ($self,$tick,$name) = @_; eval { local $^W; my $index = 1; while(my $input = $self->agent->current_form->find_input($name,'checkbox',$index)) { my $value = (grep { defined $_ } ($input->possible_values()))[0]; $self->agent->$tick($name,$value); $index++; }; $self->add_history( sprintf q{ { local $^W; my $index = 1; while(my $input = $agent->current_form->find_input('%s','checkbox',$index)) { my $value = (grep { defined $_ } ($input->possible_values()))[0]; $agent->%s('%s',$value); $index++; }; }}, $name, $tick, $name); }; warn $@ if $@; }; sub run_tick { my ($self,$key,@values) = @_; if (scalar @values) { $self->tick( "tick", $key, @values ) } else { $self->tick_all( "tick", $key ) }; }; =head2 untick Remove checkbox marks Syntax: untick NAME VALUE(s) If no value is given, all marks are removed. =cut sub run_untick { my ($self,$key,@values) = @_; if (scalar @values) { $self->tick( "untick", $key, @values ) } else { $self->tick_all( "untick", $key ) }; }; =head2 submit submits the form without clicking on any button =cut sub run_submit { my ($self) = @_; eval { my $res = $self->agent->submit; $self->status( $res->code."\n" ); $self->add_history('$agent->submit();'); $self->sync_browser if $self->option('autosync'); }; warn $@ if $@; }; =head2 click Clicks on the button named NAME. No regular expression expansion is done on NAME. Syntax: click NAME If you have a button that has no name (displayed as NONAME), use click "" to click on it. =cut sub run_click { my ($self,$button) = @_; $button ||= ""; eval { my $res = $self->agent->click($button); $self->status( "(".$res->code.")\n"); $self->activate_first_form; $self->sync_browser if ($self->option('autosync')); $self->add_history( sprintf qq{\$agent->click('%s');}, $button ); }; warn $@ if $@; }; =head2 open <open> accepts one argument, which can be a regular expression or the number of a link on the page, starting at zero. These numbers are displayed by the C<links> function. It goes directly to the page if a number is used or if the RE has one match. Otherwise, a list of links matching the regular expression is displayed. The regular expression should start and end with "/". Syntax: open [ RE | # ] =cut sub run_open { my ($self,$user_link) = @_; $user_link = $self->re_or_string($user_link); my $link = $user_link; my $user_link_expr = ref $link ? qq{qr($link)} : qq{'$link'}; unless (defined $link) { print "No link given\n"; return }; if ($link =~ /\D/) { # looks like a name/re my $re = $link if ref $link; my $count = -1; my @possible_links = $self->agent->links(); my @links = defined $re ? map { $count++; my $t = $_->text; defined $t && $t =~ /$re/ ? $count : () } @possible_links : map { $count++; my $t = $_->text; defined $t && $t eq $link ? $count : () } @possible_links; if (@links > 1) { $self->print_pairs([ @links ],[ map {$possible_links[$_]->[1]} @links ]); undef $link; } elsif (@links == 0) { print "No match.\n"; undef $link; } else { $self->status( "Found $links[0]\n" ); $link = $links[0]; if ($possible_links[$count]->url =~ /^javascript:(.*)/i) { print "Can't follow javascript link $1\n"; undef $link; }; }; }; if (defined $link) { eval { $self->agent->follow_link('n' => $link +1); my ( $hist_option, $hist_value ) = $user_link =~ /^\d+$/ ? ('n', $user_link + 1 ) : ref $user_link ? ( 'text_regex', $user_link_expr ) : ( 'text' , $user_link_expr ); $self->add_history( sprintf qq{\$agent->follow_link('%s' => %s);}, $hist_option, $hist_value ); $self->activate_first_form; if ($self->option('autosync')) { $self->sync_browser; }; $self->status( "(".$self->agent->res->code.")\n" ); }; warn $@ if $@; }; }; # Complete partially typed links : sub comp_open { my ($self,$word,$line,$start) = @_; my @completions = eval { grep {/^$word/} map { $self->link_text( $_ )} ($self->agent->find_all_links()) }; $self->display_user_warning($@) if $@; return @completions; }; =head2 back Go back one page in the browser page history. =cut sub run_back { my ($self) = @_; eval { $self->agent->back(); $self->add_history('$agent->back();'); $self->sync_browser if ($self->option('autosync')); }; warn $@ if $@; }; =head2 reload Repeat the last request, thus reloading the current page. Note that also POST requests are blindly repeated, as this command is mostly intended to be used when testing server side code. =cut sub run_reload { my ($self) = @_; eval { $self->agent->reload(); $self->add_history('$agent->reload;'); $self->sync_browser if ($self->option('autosync')); }; $self->display_user_warning($@) if $@; }; =head2 browse Open the web browser with the current page Displays the current page in the browser. =cut sub run_browse { my ($self) = @_; $self->sync_browser; }; =head2 set Set a shell option Syntax: set OPTION [value] The command lists all valid options. Here is a short overview over the different options available : autosync - automatically synchronize the browser window autorestart - restart the shell when any required module changes This does not work with C<-e> oneliners. watchfiles - watch all required modules for changes cookiefile - the file where to store all cookies dumprequests - dump all requests to STDOUT dumpresponses - dump the headers of the responses to STDOUT verbose - print commands to STDERR as they are run, when sourcing from a file =cut sub run_set { my ($self,$option,$value) = @_; $option ||= ""; if ($option && exists $self->{options}->{$option}) { if ($option and defined $value) { $self->option($option,$value); } else { $self->print_pairs( [$option], [$self->option($option)] ); }; } else { print "Unknown option '$option'\n" if $option; print "Valid options are :\n"; $self->print_pairs( [keys %{$self->{options}}], [ map {$self->option($_)} (keys %{$self->{options}}) ] ); }; }; =head2 history Display your current session history as the relevant commands. Syntax: history [FILENAME] Commands that have no influence on the browser state are not added to the history. If a parameter is given to the C<history> command, the history is saved to that file instead of displayed onscreen. =cut sub run_history { my ($self,$filename) = @_; $self->display($filename,$self->history); }; =head2 script Display your current session history as a Perl script using WWW::Mechanize. Syntax: script [FILENAME] If a parameter is given to the C<script> command, the script is saved to that file instead of displayed on the console. This command was formerly known as C<history>. =cut sub run_script { my ($self,$filename) = @_; $self->display($filename,$self->script(" ")); }; =head2 comment Adds a comment to the script and the history. The comment is prepended with a \n to increase readability. =cut sub run_comment { my $self = shift; if (@_) { $self->add_history("\n# @_ "); } } =head2 fillout Fill out the current form Interactively asks the values hat have no preset value via the autofill command. =cut sub run_fillout { my ($self) = @_; my @interactive_values; eval { $self->{answers} = []; my $form = $self->agent->current_form; if ($form) { $self->{formfiller}->fill_form($self->agent->current_form); @interactive_values = @{$self->{answers}}; } else { $self->display_user_warning( "No form found on the current page." ) }; }; warn $@ if $@; $self->add_history( join( "\n", map { sprintf( q[$formfiller->add_filler( '%s' => Fixed => '%s' );], $_->[0], defined $_->[1] ? $_->[1] : '' ) } @interactive_values) . '$formfiller->fill_form($agent->current_form);'); }; =head2 auth Set basic authentication credentials. Syntax: auth user password If you know the authority and the realm in advance, you can presupply the credentials, for example at the start of the script : >auth corion secret >get http://www.example.com Retrieving http://www.example.com(200) http://www.example.com> =cut sub run_auth { my ($self) = shift; my ($user, $password); if (scalar @_ == 2) { ($user,$password) = @_; $password = "" if not defined $password; my $code = sub { $self->agent->credentials($user => $password); }; $code->(); my $body = $self->munge_code($code); $self->add_history( sprintf( q{my ($user,$password) = ('%s','%s');}, $user, $password), $body, ); } else { $self->display_user_warning("Authentication only supports the two-argument form"); }; }; =head2 table Display a table described by the columns COLUMNS. Syntax: table COLUMNS Example: table Product Price Description If there is a table on the current page that has in its first row the three columns C<Product>, C<Price> and C<Description> (not necessarily in that order), the script will display these columns of the whole table. The C<HTML::TableExtract> module is needed for this feature. =cut sub run_table { my ($self,@columns) = @_; eval { require HTML::TableExtract; die "I need a HTML::TableExtract version of 2 or greater. I found '$HTML::TableExtract::VERSION'" if $HTML::TableExtract::VERSION < 2; my $code = sub { my $table = HTML::TableExtract->new( headers => [ @columns ] ); (my $content = $self->agent->content) =~ s/\ ?//g; $table->parse($content); my @lines; push @lines, join(", ", @columns),"\n"; for my $ts ($table->table_states) { for my $row ($ts->rows) { push @lines, ">".join(", ", @$row)."<\n"; }; }; $self->print_paged(@lines); }; $code->(); my $body = $self->munge_code($code); $self->add_history( "require HTML::TableExtract;\n", sprintf( 'my @columns = ( %s );'."\n", join( ",", map( { s/(['\\])/\\$1/g; qq('$_') } @columns ))), $body ); }; $self->display_user_warning( "Couldn't load HTML::TableExtract: $@" ) if ($@); }; =head2 tables Display a list of tables. Syntax: tables This command will display the top row for every table on the current page. This is convenient if you want to find out what the exact spellings for each column are. The command does not always work nice, for example if a site uses tables for layout, it will be harder to guess what tables are irrelevant and what tables are relevant. L<HTML::TableExtract> is needed for this feature. =cut sub run_tables { my ($self,@columns) = @_; eval { require HTML::TableExtract; die "I need a HTML::TableExtract version of 2 or greater. I found '$HTML::TableExtract::VERSION'" if $HTML::TableExtract::VERSION < 2; my $table = HTML::TableExtract->new( subtables => 1 ); (my $content = $self->agent->content) =~ s/\ ?//g; $table->parse($content); my @lines; for my $ts ($table->table_states) { my ($row) = $ts->rows; if (grep { /\S/ } (@$row)) { push @lines, join( "", "Table ", join( ",",$ts->coords ), " : ", join(",", @$row),"\n" ); }; }; $self->print_paged(@lines); }; $self->display_user_warning( $@ ) if $@; }; =head2 cookies Set the cookie file name Syntax: cookies FILENAME =cut sub run_cookies { my ($self,$filename) = @_; $self->agent->cookie_jar(HTTP::Cookies->new( file => $filename, autosave => 1, ignore_discard => 1, )); }; sub run_ { # ignore empty lines }; =head2 autofill Define an automatic value Sets a form value to be filled automatically. The NAME parameter is the WWW::Mechanize::FormFiller::Value subclass you want to use. For session fields, C<Keep> is a good candidate, for interactive stuff, C<Ask> is a value implemented by the shell. A field name starting and ending with a slash (C</>) is taken to be a regular expression and will be applied to all fields with their name matching the expression. A field with a matching name still takes precedence over the regular expression. Syntax: autofill NAME [PARAMETERS] Examples: autofill login Fixed corion autofill password Ask autofill selection Random red green orange autofill session Keep autofill "/date$/" Random::Date string "%m/%d/%Y" =cut sub run_autofill { my ($self,$name,$class,@args) = @_; @args = ($self) if ($class eq 'Ask'); if ($class) { my $name_vis; $name = $self->re_or_string($name); if (ref $name) { $name_vis = qq{qr($name)}; #warn "autofill RE detected $name"; } else { $name_vis = qq{"$name"}; }; eval { $self->{formfiller}->add_filler($name,$class,@args); $self->add_history( sprintf qq{\$formfiller->add_filler( %s => "%s" => %s ); }, $name_vis, $class, join( ",", map {qq{'$_'}} @args)); }; warn $@ if $@; } else { warn "No class for the autofiller given\n"; }; }; =head2 eval Evaluate Perl code and print the result Syntax: eval CODE For the generated scripts, anything matching the regular expression C</\$self-E<gt>agent\b/> is automatically replaced by C<$agent> in your eval code, to do the Right Thing. Examples: # Say hello eval "Hello World" # And take a look at the current content type eval $self->agent->ct =cut sub run_eval { my ($self,@rest) = @_; my $code = $self->line; if ($code !~ /^eval\s+(.*)$/sm) { #warn "Don't know what to do with '$code'"; $self->display_user_warning("Don't know what to make of '$code'"); } else { my $str = $1; my $code = qq{ do { $str } }; my @res = eval $code; if (my $err = $@) { #warn "Don't know what to do with '$str' ($err)"; $self->display_user_warning($err); return }; print join "", @res,"\n"; my $script_code = $self->munge_code(qq{print $code, "\\n";}); #warn "Script: $script_code<<"; $self->add_history( $script_code ); }; }; =head2 source Execute a batch of commands from a file Syntax: source FILENAME =cut sub run_source { my ($self,$file) = @_; if ($file) { eval { $self->source_file($file); }; if ($@) { $self->display_user_warning( "Could not source file '$file' : $@" ); }; } else { print "Syntax: source FILENAME\n"; }; }; =head2 versions Print the version numbers of important modules Syntax: versions =cut sub run_versions { my ($self) = @_; no strict 'refs'; my @modules = qw( WWW::Mechanize::Shell WWW::Mechanize::FormFiller WWW::Mechanize Term::Shell HTML::Parser HTML::TableExtract HTML::Parser HTML::Display Pod::Constants File::Modified ); eval "require $_" foreach @modules; $self->print_pairs( [@modules], [map { defined ${"${_}::VERSION"} ? ${"${_}::VERSION"} : "<undef>" } @modules]); }; =head2 timeout Set new timeout value for the agent. Effects all subsequent requests. VALUE is in seconds. Syntax: timeout VALUE =cut sub run_timeout { my ($self, $timeout) = @_; if ($timeout) { eval { $self->agent->timeout($timeout); }; if ($@) { print "Could not set new timeout value : $@"; }; $self->add_history( sprintf q{$agent->timeout(%s);}, $timeout); } else { print "Syntax: timeout VALUE\n"; }; }; =head2 ct prints the content type of the most current response. Syntax: ct =cut sub run_ct { my ($self) = @_; if ($self->agent->content) { eval { print $self->agent->ct, "\n"; }; if ($@) { print "Could not get content-type : $@"; }; $self->add_history('print $agent->ct, "\n";'); } else { print "No content available yet!\n"; } }; =head2 referrer set the value of the Referer: header Syntax: referer URL referrer URL =cut sub run_referrer { my ($self, $referrer) = @_; if (defined $referrer) { eval { $self->agent->add_header(Referer => $referrer); }; if ($@) { print "Could not set referrer : $@"; }; # warn "Added $referrer"; $self->add_history( sprintf q{$agent->add_header('Referer', '%s');}, $referrer); } else { # print "syntax: referer|referrer URL\n"; eval { print "Referer: ", $self->agent->{req}->header('Referer'),"\n"; }; } }; =head2 referer Alias for referrer =cut sub run_referer { goto &WWW::Mechanize::Shell::run_referrer }; # sub alias_referrer { qw(referer) }; =head2 response display the last server response =cut sub run_response { my ($self) = @_; eval { $self->print_paged( $self->agent->res->as_string )}; }; =head2 C<< $shell->munge_code( CODE ) >> Munges a coderef to become code fit for output independent of WWW::Mechanize::Shell. =cut our %munge_map = ( '^{' => '', '}$' => '', '\$self->print_paged' => 'print ', '\$self->agent' => '$agent', '\s*package ' . __PACKAGE__ . ';' => '', ); sub munge_code { my ($self, $code) = @_; my $body; if (ref $code) { # Munge code my $d = B::Deparse->new('-sC'); if ($d->can('ambient_pragmas')) { $d->ambient_pragmas(strict => 'all', warnings => 'all'); }; $body = $d->coderef2text($code); } else { $body = $code } while (my ($key,$val) = each %munge_map) { $body =~ s/$key/$val/gs; }; $body }; =head2 C<< shell >> This subroutine is exported by default as a convenience method so that the following oneliner invocation works: perl -MWWW::Mechanize::Shell -eshell You can pass constructor arguments to this routine as well. Any scripts given in C<< @ARGV >> will be run. If C<< @ARGV >> is empty, an interactive loop will be started. =cut sub shell { my @args = ("shell",@_); my $shell = WWW::Mechanize::Shell->new(@args); if (@ARGV) { $shell->source_file( @ARGV ); } else { $shell->cmdloop; }; }; { package # hide from CPAN WWW::Mechanize::FormFiller::Value::Ask; use WWW::Mechanize::FormFiller; use base 'WWW::Mechanize::FormFiller::Value::Callback'; our $VERSION = '0.59'; sub new { my ($class,$name,$shell) = @_; # Using the name here to allow for late binding and overriding via eval() # from the shell command line #warn __PACKAGE__ . "::ask_value"; my $self = $class->SUPER::new($name, __PACKAGE__ . '::ask_value'); $self->{shell} = $shell; Carp::carp "WWW::Mechanize::FormFiller::Value::Ask->new called without a value for the shell" unless $self->{shell}; $self; }; sub ask_value { my ($self,$input) = @_; my @values; if ($input->possible_values) { @values = $input->possible_values; print join( "|", @values ), "\n"; }; my $value; $value = $input->value; #warn $value if $value; if ($input->type !~ /^(submit|hidden)$/) { $value = $self->{shell}->prompt("(" . $input->type . ")" . $input->name . "> [" . ($input->value || "") . "] ", ($input->value||''), @values ); undef $value if ($value eq "" and $input->type eq "checkbox"); push @{$self->{shell}->{answers}}, [ $input->name, $value ]; }; $value; }; }; __END__ =head1 SAMPLE SESSIONS =head2 Entering values # Search for a term on Google get http://www.google.com value q "Corions Homepage" click btnG script # (yes, this is a bad example of automating, as Google # already has a Perl API. But other sites don't) =head2 Retrieving a table get http://www.perlmonks.org open "/Saints in/" table User Experience Level script # now you have a program that gives you a csv file of # that table. =head2 Uploading a file get http://aliens:xxxxx/ value f path/to/file click "upload" =head2 Batch download # download prerelease versions of my modules get http://www.corion.net/perl-dev save /.tar.gz$/ =head1 REGULAR EXPRESSION SYNTAX Some commands take regular expressions as parameters. A regular expression B<must> be a single parameter matching C<^/.*/([isxm]+)?$>, so you have to use quotes around it if the expression contains spaces : /link_foo/ # will match as (?-xims:link_foo) "/link foo/" # will match as (?-xims:link foo) Slashes do not need to be escaped, as the shell knows that a RE starts and ends with a slash : /link/foo/ # will match as (?-xims:link/foo) "/link/ /foo/" # will match as (?-xims:link/\s/foo) The C</i> modifier works as expected. If you desire more power over the regular expressions, consider dropping to Perl or recommend me a good parser module for regular expressions. =head1 DISPLAYING HTML WWW::Mechanize::Shell now uses the module HTML::Display to display the HTML of the current page in your browser. Have a look at the documentation of HTML::Display how to make it use your browser of choice in the case it does not already guess it correctly. =head1 FILLING FORMS VIA CUSTOM CODE If you want to stay within the confines of the shell, but still want to fill out forms using custom Perl code, here is a recipe how to achieve this : Code passed to the C<eval> command gets evalutated in the WWW::Mechanize::Shell namespace. You can inject new subroutines there and these get picked up by the Callback class of WWW::Mechanize::FormFiller : # Fill in the "date" field with the current date/time as string eval sub &::custom_today { scalar localtime }; autofill date Callback WWW::Mechanize::Shell::custom_today fillout This method can also be used to retrieve data from shell scripts : # Fill in the "date" field with the current date/time as string # works only if there is a program "date" eval sub &::custom_today { chomp `date` }; autofill date Callback WWW::Mechanize::Shell::custom_today fillout As the namespace is different between the shell and the generated script, make sure you always fully qualify your subroutine names, either in your own namespace or in the main namespace. =head1 GENERATED SCRIPTS The C<script> command outputs a skeleton script that reproduces your actions as done in the current session. It pulls in C<WWW::Mechanize::FormFiller>, which is possibly not needed. You should add some error and connection checking afterwards. =head1 ADDING FIELDS TO HTML If you are automating a JavaScript dependent site, you will encounter JavaScript like this : <script> document.write( "<input type=submit name=submit>" ); </script> HTML::Form will not know about this and will not have provided a submit button for you (understandably). If you want to create such a submit button from within your automation script, use the following code : $agent->current_form->push_input( submit => { name => "submit", value =>"submit" } ); This also works for other dynamically generated input fields. To fake an input field from within a shell session, use the C<eval> command : eval $self->agent->current_form->push_input(submit=>{name=>"submit",value=>"submit"}); And yes, the generated script should do the Right Thing for this eval as well. =head1 LOCAL FILES If you want to use the shell on a local file without setting up a C<http> server to serve the file, you can use the C<file:> URI scheme to load it into the "browser": get file:local.html forms =head1 PROXY SUPPORT Currently, the proxy support is realized via a call to the C<env_proxy> method of the WWW::Mechanize object, which loads the proxies from the environment. There is no provision made to prevent using proxies (yet). The generated scripts also load their proxies from the environment. =head1 ONLINE HELP The online help feature is currently a bit broken in C<Term::Shell>, but a fix is in the works. Until then, you can re-enable the dynamic online help by patching C<Term::Shell> : Remove the three lines my $smry = exists $o->{handlers}{$h}{smry} ? $o->summary($h) : "undocumented"; in C<sub run_help> and replace them by my $smry = $o->summary($h); The shell works without this patch and the online help is still available through C<perldoc WWW::Mechanize::Shell> =head1 BUGS Bug reports are very welcome - please use the RT interface at https://rt.cpan.org/NoAuth/Bugs.html?Dist=WWW-Mechanize-Shell or send a descriptive mail to bug-WWW-Mechanize-Shell@rt.cpan.org . Please try to include as much (relevant) information as possible - a test script that replicates the undesired behaviour is welcome every time! =over 4 =item * The two parameter version of the C<auth> command guesses the realm from the last received response. Currently a RE is used to extract the realm, but this fails with some servers resp. in some cases. Use the four parameter version of C<auth>, or if not possible, code the extraction in Perl, either in the final script or through C<eval> commands. =item * The shell currently detects when you want to follow a JavaScript link and tells you that this is not supported. It would be nicer if there was some callback mechanism to (automatically?) extract URLs from JavaScript-infected links. =back =head1 TODO =over 4 =item * Add XPath expressions (by moving C<WWW::Mechanize> from HTML::Parser to XML::XMLlib or maybe easier, by tacking Class::XPath onto an HTML tree) =item * Add C<head> as a command ? =item * Optionally silence the HTML::Parser / HTML::Forms warnings about invalid HTML. =back =head1 EXPORT The routine C<shell> is exported into the importing namespace. This is mainly for convenience so you can use the following commandline invocation of the shell like with CPAN : perl -MWWW::Mechanize::Shell -e"shell" =head1 REPOSITORY The public repository of this module is L<https://github.com/Corion/WWW-Mechanize-Shell>. =head1 SUPPORT The public support forum of this module is L<http://perlmonks.org/>. =head1 COPYRIGHT AND LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Copyright (C) 2002-2020 Max Maischein =head1 AUTHOR Max Maischein, E<lt>corion@cpan.orgE<gt> Please contact me if you find bugs or otherwise improve the module. More tests are also very welcome ! =head1 SEE ALSO L<WWW::Mechanize>,L<WWW::Mechanize::FormFiller>,L<WWW::Mechanize::Firefox> =cut ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/META.json������������������������������������������������������������������0000644�0001750�0001750�00000003735�13654075103�016102� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������{ "abstract" : "An interactive shell for WWW::Mechanize", "author" : [ "Max Maischein <corion@cpan.org>" ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 7.1002, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "WWW-Mechanize-Shell", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "HTML::Display" : "0", "HTML::TokeParser::Simple" : "2", "HTTP::Cookies" : "0", "Hook::LexWrap" : "0.2", "LWP" : "5.69", "LWP::UserAgent" : "0", "Term::Shell" : "0.02", "Test::Harness" : "2.3", "URI::URL" : "0", "WWW::Mechanize" : "1.2", "WWW::Mechanize::FormFiller" : "0.05", "WWW::Mechanize::Link" : "1.2", "parent" : "0", "perl" : "5.006" } }, "test" : { "requires" : { "CGI" : "0", "File::Temp" : "0", "Test::HTTP::LocalServer" : "0.68", "Test::More" : "0", "Test::Without::Module" : "0", "URI" : "0" } } }, "release_status" : "stable", "resources" : { "license" : [ "https://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://github.com/Corion/WWW-Mechanize-Shell.git", "web" : "https://github.com/Corion/WWW-Mechanize-Shell" } }, "version" : "0.59", "x_serialization_backend" : "JSON::PP version 2.27300_01", "x_static_install" : 1 } �����������������������������������WWW-Mechanize-Shell-0.59/xt/������������������������������������������������������������������������0000755�0001750�0001750�00000000000�13654075103�015104� 5����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/xt/99-todo.t���������������������������������������������������������������0000644�0001750�0001750�00000002166�13654075102�016501� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test::More; use File::Spec; use File::Find; use strict; # Check that all files do not contain any # lines with "XXX" - such markers should # either have been converted into Todo-stuff # or have been resolved. # The test was provided by Andy Lester. require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; plan tests => 2* @files; foreach my $file (@files) { source_file_ok($file); } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } sub source_file_ok { my $file = shift; open( my $fh, '<', $file ) or die "Can't open $file: $!"; my @lines = <$fh>; close $fh; my $n = 0; for ( @lines ) { ++$n; s/^/$file ($n): /; } my @x = grep /XXX/, @lines; if ( !is( scalar @x, 0, "Looking for XXXes in $file" ) ) { diag( $_ ) for @x; } @x = grep /<<<|>>>/, @lines; if ( !is( scalar @x, 0, "Looking for <<<<|>>>> in $file" ) ) { diag( $_ ) for @x; } } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/xt/99-changes.t������������������������������������������������������������0000644�0001750�0001750�00000001337�13654075102�017143� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!perl -w use warnings; use strict; use File::Find; use Test::More tests => 2; =head1 PURPOSE This test ensures that the Changes file mentions the current version and that a release date is mentioned as well =cut require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my $module = $module{NAME}; (my $file = $module) =~ s!::!/!g; require "$file.pm"; my $version = sprintf '%0.2f', $module->VERSION; my $changes = do { local $/; open my $fh, 'Changes' or die $!; <$fh> }; ok $changes =~ /^(.*$version.*)$/m, "We find version $version for $module"; my $changes_line = $1; ok $changes_line =~ /$version\s+20\d\d-[01]\d-[0123]\d\b/, "We find a release date on the same line" or diag $changes_line; �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/xt/99-manifest.t�����������������������������������������������������������0000644�0001750�0001750�00000002044�13654075102�017335� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use Test::More; # Check that MANIFEST and MANIFEST.skip are sane : use File::Find; use File::Spec; my @files = qw( MANIFEST MANIFEST.SKIP ); plan tests => scalar @files * 4 +1 # MANIFEST existence check +1 # MYMETA.* non-existence check ; for my $file (@files) { ok(-f $file, "$file exists"); open my $fh, '<', $file or die "Couldn't open $file : $!"; my @lines = <$fh>; is_deeply([grep(/^$/, @lines)],[], "No empty lines in $file"); is_deeply([grep(/^\s+$/, @lines)],[], "No whitespace-only lines in $file"); is_deeply([grep(/^\s*\S\s+$/, @lines)],[],"No trailing whitespace on lines in $file"); if ($file eq 'MANIFEST') { chomp @lines; is_deeply([grep { s/\s.*//; ! -f } @lines], [], "All files in $file exist") or do { diag "$_ is mentioned in $file but doesn't exist on disk" for grep { ! -f } @lines }; # Exclude some files from shipping is_deeply([grep(/^MYMETA\.(yml|json)$/, @lines)],[],"We don't try to ship MYMETA.* $file"); }; close $fh; }; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/xt/99-unix-text.t����������������������������������������������������������0000644�0001750�0001750�00000001745�13654075102�017503� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test::More; # Check that all released module files are in # UNIX text format use File::Spec; use File::Find; use strict; my @files = ('Makefile.PL', 'MANIFEST', 'MANIFEST.SKIP', glob 't/*.t'); require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; plan tests => scalar @files; foreach my $file (@files) { unix_file_ok($file); } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } sub unix_file_ok { my ($filename) = @_; local $/; open my $fh, '<', $filename or die "Couldn't open '$filename' : $!\n"; binmode $fh; my $content = <$fh>; my $i; my @lines = grep { /\x0D\x0A$/sm } map { sprintf "%s: %s\x0A", $i++, $_ } split /\x0A/, $content; unless (is(scalar @lines, 0,"'$filename' contains no windows newlines")) { diag $_ for @lines; }; close $fh; }; ���������������������������WWW-Mechanize-Shell-0.59/xt/99-test-prerequisites.t�������������������������������������������������0000644�0001750�0001750�00000006600�13654075102�021412� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!perl -w use warnings; use strict; use Test::More; use Data::Dumper; use File::Find; =head1 DESCRIPTION This test checks whether all tests still pass when the optional test prerequisites for the test are not present. This is done by using L<Test::Without::Module> to rerun the test while excluding the optional prerequisite. =cut BEGIN { eval { require CPAN::Meta::Prereqs; require Parse::CPAN::Meta; require Perl::PrereqScanner::Lite; require Module::CoreList; require Test::Without::Module; require Capture::Tiny; Capture::Tiny->import('capture'); require Path::Class; Path::Class->import('dir'); }; if (my $err = $@) { warn "# $err"; plan skip_all => "Prerequisite needed for testing is missing"; exit 0; }; }; my @tests; if( @ARGV ) { @tests = @ARGV; } else { open my $manifest, '<', 'MANIFEST' or die "Couldn't read MANIFEST: $!"; @tests = grep { -f $_ } grep { m!^(t/.*\.t|scripts/.*\.pl)$! } map { s!\s*$!!; $_ } <$manifest> } plan tests => 0+@tests; my $meta = Parse::CPAN::Meta->load_file('META.json'); # Find what META.* declares my $explicit_test_prereqs = CPAN::Meta::Prereqs->new( $meta->{prereqs} )->merged_requirements->as_string_hash; my $minimum_perl = $meta->{prereqs}->{runtime}->{requires}->{perl} || 5.006; sub distributed_packages { my @modules; for( @_ ) { dir($_)->recurse( callback => sub { my( $child ) = @_; if( !$child->is_dir and $child =~ /\.pm$/) { push @modules, ((scalar $child->slurp()) =~ m/^\s*package\s+(?:#.*?\n\s+)*(\w+(?:::\w+)*)\b/msg); } }); }; map { $_ => $_ } @modules; } # Find what we distribute: my %distribution = distributed_packages('blib','t'); my $scanner = Perl::PrereqScanner::Lite->new; for my $test_file (@tests) { my $implicit_test_prereqs = $scanner->scan_file($test_file)->as_string_hash; my %missing = %{ $implicit_test_prereqs }; #warn Dumper \%missing; for my $p ( keys %missing ) { # remove core modules if( Module::CoreList::is_core( $p, undef, $minimum_perl)) { delete $missing{ $p }; #diag "$p is core for $minimum_perl"; } else { #diag "$p is not in core for $minimum_perl"; }; # remove explicit (test) prerequisites for my $k (keys %$explicit_test_prereqs) { delete $missing{ $k }; }; #warn Dumper $explicit_test_prereqs->as_string_hash; # Remove stuff from our distribution for my $k (keys %distribution) { delete $missing{ $k }; }; } # If we have no apparent missing prerequisites, we're good my @missing = sort keys %missing; # Rerun the test without these modules and see whether it crashes my @failed; for my $candidate (@missing) { diag "Checking that $candidate is not essential"; my @cmd = ($^X, "-MTest::Without::Module=$candidate", "-Mblib", '-w', $test_file); my $cmd = join " ", @cmd; my ($stdout, $stderr, $exit) = capture { system( @cmd ); }; if( $exit != 0 ) { push @failed, [ $candidate, [@cmd]]; } elsif( $? != 0 ) { push @failed, [ $candidate, [@cmd]]; }; }; is 0+@failed, 0, $test_file or diag Dumper \@failed; }; done_testing; ��������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/xt/99-pod.t����������������������������������������������������������������0000644�0001750�0001750�00000001455�13654075102�016316� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use Test::More; # Check our Pod # The test was provided by Andy Lester, # who stole it from Brian D. Foy # Thanks to both ! use File::Spec; use File::Find; use strict; eval { require Test::Pod; Test::Pod->import; }; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; if ($@) { plan skip_all => "Test::Pod required for testing POD"; } elsif ($Test::Pod::VERSION < 0.95) { plan skip_all => "Test::Pod 0.95 required for testing POD"; } else { my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; plan tests => scalar @files; foreach my $file (@files) { pod_file_ok($file); } } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/xt/copyright.t�������������������������������������������������������������0000644�0001750�0001750�00000004650�13654075102�017305� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!perl use warnings; use strict; use File::Find; use Test::More tests => 1; use POSIX 'strftime'; my $this_year = strftime '%Y', localtime; my $last_modified_year = 0; my $is_checkout = -d '.git'; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; #my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ('lib')); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } sub collect { my( $file ) = @_; note $file; my $modified_ts; if( $is_checkout ) { # diag `git log -1 --pretty="format:%ct" "$file"`; $modified_ts = `git log -1 --pretty="format:%ct" "$file"`; } else { $modified_ts = (stat($_))[9]; } my $modified_year; if( $modified_ts ) { $modified_year = strftime('%Y', localtime($modified_ts)); } else { $modified_year = 1970; }; open my $fh, '<', $file or die "Couldn't read $file: $!"; my @copyright = map { /\bcopyright\b.*?\d{4}-(\d{4})\b/i ? [ $_ => $1 ] : () } <$fh>; my $copyright = 0; for (@copyright) { $copyright = $_->[1] > $copyright ? $_->[1] : $copyright; }; return { file => $file, copyright_lines => \@copyright, copyright => $copyright, modified => $modified_year, }; }; my @results; for my $file (@files) { push @results, collect($file); }; for my $file (@results) { $last_modified_year = $last_modified_year < $file->{modified} ? $file->{modified} : $last_modified_year; }; note "Distribution was last modified in $last_modified_year"; my @out_of_date = grep { $_->{copyright} and $_->{copyright} < $last_modified_year } @results; if(! is 0+@out_of_date, 0, "All files have a current copyright year ($last_modified_year)") { for my $file (@out_of_date) { diag sprintf "%s modified %d, but copyright is %d", $file->{file}, $file->{modified}, $file->{copyright}; diag $_ for map {@$_} @{ $file->{copyright_lines}}; }; diag q{To fix (in a rough way, please review) run}; diag sprintf q{ perl -i -ple 's!(\bcopyright\b.*?\d{4}-)(\d{4})\b!${1}%s!i' %s}, $this_year, join ' ', map { $_->{file} } @out_of_date; }; ����������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/xt/99-compile.t������������������������������������������������������������0000644�0001750�0001750�00000002025�13654075102�017156� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!perl use warnings; use strict; use File::Find; use Test::More; BEGIN { eval 'use Capture::Tiny ":all"; 1'; if ($@) { plan skip_all => "Capture::Tiny needed for testing"; exit 0; }; }; plan 'no_plan'; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my $last_version = undef; sub check { #return if (! m{(\.pm|\.pl) \z}xmsi); my ($stdout, $stderr, $exit) = capture(sub { system( $^X, '-Mblib', '-c', $_ ); }); s!\s*\z!! for ($stdout, $stderr); if( $exit ) { diag $stderr; diag "Exit code: ", $exit; fail($_); } elsif( $stderr ne "$_ syntax OK") { diag $stderr; fail($_); } else { pass($_); }; } my @files; find({wanted => \&wanted, no_chdir => 1}, grep { -d $_ } 'blib/lib', 'examples', 'lib' ); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; for (@files) { check($_) } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/xt/99-synopsis.t�����������������������������������������������������������0000644�0001750�0001750�00000003011�13654075102�017411� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; use Test::More; use File::Spec; use File::Find; use File::Temp 'tempfile'; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); #if( my $exe = $module{EXE_FILES}) { # push @files, @$exe; #}; plan tests => scalar @files; foreach my $file (@files) { synopsis_file_ok($file); } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/ and $_ !~ /\bDSL\.pm$/; # we skip that one as it initializes immediately } sub synopsis_file_ok { my( $file ) = @_; my $name = "SYNOPSIS in $file compiles"; open my $fh, '<', $file or die "Couldn't read '$file': $!"; my @synopsis = map { s!^\s\s!!; $_ } # outdent all code for here-docs grep { /^\s\s/ } # extract all verbatim (=code) stuff grep { /^=head1\s+SYNOPSIS$/.../^=/ } # extract Pod synopsis <$fh>; if( @synopsis ) { my($tmpfh,$tempname) = tempfile(); print {$tmpfh} join '', @synopsis; close $tmpfh; # flush it my $output = `$^X -Ilib -c $tempname 2>&1`; if( $output =~ /\ssyntax OK$/ ) { pass $name; } else { fail $name; diag $output; diag $_ for @synopsis; }; unlink $tempname or warn "Couldn't clean up $tempname: $!"; } else { SKIP: { skip "$file has no SYNOPSIS section", 1; }; }; } �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/xt/99-versions.t�����������������������������������������������������������0000644�0001750�0001750�00000002712�13654075102�017401� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!perl -w # Stolen from ChrisDolan on use.perl.org # http://use.perl.org/comments.pl?sid=29264&cid=44309 use warnings; use strict; use File::Find; use Test::More; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; sub read_file { open my $fh, '<', $_[0] or die "Couldn't read '$_[0]': $!"; binmode $fh; local $/; <$fh> } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } plan tests => 0+@files; my $last_version = undef; sub check { my $content = read_file($_); # only look at perl scripts, not sh scripts return if (m{blib/script/}xms && $content !~ m/\A \#![^\r\n]+?perl/xms); my @version_lines = $content =~ m/ ( [^\n]* \$VERSION \s* = [^=] [^\n]* ) /gxms; if (@version_lines == 0) { fail($_); } for my $line (@version_lines) { $line =~ s/^\s+//; $line =~ s/\s+$//; if (!defined $last_version) { $last_version = shift @version_lines; diag "Checking for $last_version"; pass($_); } else { is($line, $last_version, $_); } } } for (@files) { check(); }; if (! defined $last_version) { fail('Failed to find any files with $VERSION'); } ������������������������������������������������������WWW-Mechanize-Shell-0.59/xt/99-minimumversion.t�����������������������������������������������������0000644�0001750�0001750�00000000471�13654075102�020612� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!perl -w use strict; use Test::More; eval { #require Test::MinimumVersion::Fast; require Test::MinimumVersion; Test::MinimumVersion->import; }; my @files; if ($@) { plan skip_all => "Test::MinimumVersion required for testing minimum Perl version"; } else { all_minimum_version_from_metajson_ok(); } �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/xt/meta-lint.t�������������������������������������������������������������0000644�0001750�0001750�00000002156�13654075102�017166� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!perl -w # Stolen from ChrisDolan on use.perl.org # http://use.perl.org/comments.pl?sid=29264&cid=44309 use warnings; use strict; use File::Find; use Test::More; eval { #require Test::MinimumVersion::Fast; require Parse::CPAN::Meta; Parse::CPAN::Meta->import(); require CPAN::Meta::Validator; CPAN::Meta::Validator->import(2.15); }; if ($@) { plan skip_all => "CPAN::Meta::Validator version 2.15 required for testing META files"; } else { plan tests => 4; } use lib '.'; our %module; require 'Makefile.PL'; # Loaded from Makefile.PL %module = get_module_info(); my $module = $module{NAME}; (my $file = $module) =~ s!::!/!g; require "$file.pm"; my $version = sprintf '%0.2f', $module->VERSION; for my $meta_file ('META.yml', 'META.json') { my $meta = Parse::CPAN::Meta->load_file($meta_file); my $cmv = CPAN::Meta::Validator->new( $meta ); if(! ok $cmv->is_valid, "$meta_file is valid" ) { diag $_ for $cmv->errors; }; # Also check that the declared version matches the version in META.* is $meta->{version}, $version, "$meta_file version matches module version ($version)"; }; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/Changes��������������������������������������������������������������������0000644�0001750�0001750�00000042646�13654075102�015757� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Revision history for Perl extension WWW::Mechanize::Shell. Todo: * Think about HTML::FillInForm for displaying changed form values interactively * Check how the new WWW::Mechanize JavaScript handling interacts with the shells own JS blocking (badly, I guess) * Use Scalar::Util::weaken if available * Think how to add other (Xpath) extractions to conveniently display stuff via CSS selectors or XPath selectors. Steal from Web::Scraper. * There is a memory leak between ::FormFiller and ::Shell * Ditch Hook::LexWrap now that LWP::UserAgent has progress callbacks * Add set-cookie and delete-cookie commands * Add (optional) HTTP::Cookies::Find support 0.59 2020-05-04 * HTML::Form::find_input() has a 1-based index Reported by the CPAN testers, thanks! 0.58 2019-09-30 * Made the tests pass on IPv6 enabled systems Uncovered by making Test::HTTP::LocalServer work on IPv6 enabled systems. * Test-only improvements, no need to upgrade 0.57 2018-06-04 * Add "images" command to list all images * Allow other user agent objects like WWW::Mechanize::Chrome Use it from the command line as perl -Ilib -MWWW::Mechanize::Chrome \ -MWWW::Mechanize::Shell \ -e"shell(agent => WWW::Mechanize::Chrome->new())" 0.56 2017-04-25 * Send uncompressed output to the browser (contributed by weltonrodrigo) * Fix some warnings caused by links without a text * Fix test suite due to newer version of Test::Without::Module * Upgrade the test HTTP server to work in absence of CGI.pm 0.55 2015-04-26 * Fix one more test against new sprintf() warnings in 5.21+ 0.54 2015-04-26 * Fix test suite against new sprintf() warnings in 5.21+ * Fix test suite against calling CGI::param in list context Both analyzed and contributed by Slaven Rezic 0.53 2013-08-10 * Add links to repository, contributed by D. Steinbrunner 0.52 2011-01-06 * Fix stupid thinko in test (only affects tests on 5.13+) 0.51 2011-01-05 * Make a test more robust against 5.14 * Streamlined Exporter.pm usage * Rely on parent.pm instead of base.pm * No need to upgrade 0.50 2010-08-21 * Remove test file that was just testing LWP functionality and that failed for some weird setups where nonexistent hosts still result in a successful HTTP request. * Added links to repositories 0.49 2010-08-17 * Apply [rt.cpan.org #59246] , thanks to Ansgar Burchardt This fixes another case where API changes in LWP weren't mirrored by this module. * Fix t/14-command-identity.t to not make an external request anymore Addresses [rt.cpan.org #59883] 0.48 2008-11-09 * More test fixes for incompatibilities between LWP and Mechanize 1.34+ * Removed way to set up authentication for more than one site * WWW::Mechanize monkeypatches LWP::UserAgent and thus you can only ever have one set of user/password in your script. 0.47 2008-11-02 * Fix tests to work with libwww 5.815+ which automatically retries with empty user/password * WWW::Mechanize 1.34+ breaks Basic authentication with LWP 5.815+ so all auth tests are skipped until Andy Lester and Gisle Aas work out who has to fix their stuff. * Hook::LexWrap is subject to bug [perl #46217], this might cause problems if you're running Perl 5.10.0. All tests pass. 0.46 2007-10-03 * Bump version because of borked CPAN upload, retrying * No need to upgrade 0.45 2007-10-03 * No library code changes, no need to upgrade * Removed HTML::Display from the distribution as that now lives its own life on CPAN * Fix failing tests if HTTP_PROXY was set. This fixes Debian bug #444634, http://bugs.debian.org/444634 and CPAN RT #29455, thanks to Niko Tyni 0.44 2007-07-07 * Added C<title> and C<headers> commands that print out the title and headers of the page. Suggested by Ed Halley. * Added and documented arguments to the C<< shell >> subroutine * Quieted up some test warnings * IO::Catch now understands C<printf> * Upgrade to Term::Shell v0.02 which now displays the help summary better. 0.43 2007-05-11 * fix failures on 5.6.2 with a B::Deparse version that doesn't support ->ambient_pragmas() - they get ignored there now. 0.42 200704.. * Test fixes only, no need to upgrade * Patches submitted by MAREKR (RT #26397) and somebody else whose name I cannot find, sorry. * Delete some more proxy settings for the test runs 0.41 2007-04-14 * Codeacrobat release * Restore compatibility with WWW::Mechanize 1.22 Thanks to Jörg Meltzer who sent in the patch 0.40 2007-01-17 * Fixed showstopper bug in prompt method that was hidden by all tests disabling interactive prompts Thanks to all reporters 0.39 * Bumped module version * Fix for RT 22121 - shell does not start 0.38 2006-12-14 * Bumped module version * Added a test for HTML::TableExtract functionality which went untested so far * Fixed HTML::TableExtract functionality This functionality now requires HTML::TableExtract 2.0 or higher, sorry * This release now needs WWW::Mechanize 1.20, for the update_html method which is used in the tests. Sorry. * Reworked code generation and code execution * ! Think about plugins for other extractions: * Template::Extract * XML::XPath extractions * Think about using a different shell framework provider 0.37 * Fixed bug that created invalid code for the C<auth> command 0.36 * Fixed the actual bug too. 0.35 * Fixed documentation in HTML::Display::Debian about C<x-www-browser>. 0.34 * Fixed a bug where C<form 2> resulted in an error. Now selecting a form by number actually works. Thanks for the report via RT. 0.33 * The C<form> command now got a life of its own instead of being a lazy abbreviation of the C<forms> command. It takes a form name or form number. 0.32 * now WWW::Mechanize::Shell directly uses HTML::TokeParser::Simple. Previously, it was only needed for special cases of HTML::Display. * WWW::Mechanize::Shell now strips all "target" attributes from your HTML. 0.31 * test t/13* didn't work when the CPAN build directory contains a space * Added patch by Philippe "BooK" Bruhat to allow downloading big files directly to disk. Changed behaviour: * The referrer header now always points to the original page you save from when using the C<save> command. 0.30 * Now needs the latest? Test::Harness because otherwise some tests failed from time to time for no apparent reason. * using Devel::Cover. Code coverage of WWW/Mechanize/Shell.pm is now at 75.00% through the test suite * Provide better text for all links (for example when the content is an image) * Now moved to use WWW::Mechanize::Link instead of direct array access * This means it requires WWW::Mechanize 0.57 or higher * added "comment" command, which allows to add comments to both, the shell script and the generated script. (Donated by Alexander Goller) * accomodated for most recent version of LWP, which dosen't die on failing host lookups but returns error 500. 0.29 * Fixed bug when autocompletion did crash the shell (S. Rezic) * HTML::Display::Opera does not open a new window anymore (S. Rezic) * Moved private package "Catch" to IO::Catch and made all tests use that package 0.28 * Add $PAGER support for multiline output * "referer" command now prints the old referer if no new value is given * added RT bug email address to documentation 0.27 * now needs WWW::Mechanize 0.47 * added "tick" and "untick" commands (plus tests) * fixed t/14*.t so that now the correct locations are used * removed ::Unwrap class that was not used anywhere * If more than one value is passed to the "value" command, the parameters are concatenated with spaces * added test that all released files are in Unix text format * added "dumpresponses" option * added "verbose" option that prints the commands while sourcing a file (Prakash Kailasa) * "content" now can save the content to a file (Prakash Kailasa) * added "ct" command to print the Context-Type header (Prakash Kailasa) * added "referer" and "referrer" command to change the Referer header (Prakash Kailasa) * added "timeout" command to set the LWP::UserAgent timeout (Prakash Kailasa) * added "response" command to display the complete response (request by Mark Stosberg) * updated tests to accomodate for the new commands 0.26 * added RE support to autofill * fixed broken HTML display as the filename was passed doubled * POD fixes * HTML::Display now checks for @ISA before loading a file * Displaying shared files is now tested against * Updated POD to reflect the new RE parsing 0.25 * The "versions" command also lists HTML::Display now * hunted down and fixed error in skipping too many tests in t/01-Win32-OLE-fallback.t * fixed redefinition warning in t/00-use.t * updated local server tests 0.24 - fixup release for 0.23 * Added $VERSION to all HTML::Display modules * patched handing of BASE tags, so that more cases are caught. This adds HTML::TokeParser::Simple as a prerequisite. Thanks to Mark Stosberg for the initial patch! * fixed loading of classes in HTML::Display. Classes are only required if there is no method "display_html" in that namespace already. * fixed embarassing Linux compatibility bugs * HTML::Display::TempFile now also works under Windows where sharing did not allow another process to read the file while it was being written 0.23 * "submit" didn't reload the browser HTML. Thanks to Slaven Rezic. * t/14* now skips instead of fails tests that can't succeed. * fixed test failing if Term::ReadKey was not available * fixed synopsis code not reading the .mechanizerc * made WWW::Mechanize::Shell use the "reload" method of WWW::Mechanize (after all, I asked for that method ...) * Test for multivalues added, but it's not testing the right stuff yet (see https://rt.cpan.org/Ticket/Display.html?id=2700 ). Not in MANIFEST and/or distribution, but the Changes file is also for me :-) * clarified documentation about "watchfiles" and "autoreload" (thanks to Mark Stosberg) * Documentation fixes for "open" and "links" (also courtesy of Mark Stosberg) * The dumprequests feature needs Hook::LexWrap - it didn't work properly before. The feature is tested in t/14 * "restart" in a -e oneliner dosen't crash the shell (it also dosen't restart though) * factored out the HTML display into a module of its own (HTML::Display), distributed with this. This breaks existing setups, as the "browsercmd" and "useole" option disappeared. You can configure the used browser class by setting the environment variable PERL_HTML_DISPLAY_CLASS or PERL_HTML_DISPLAY_COMMAND, either in your environment or in your mechanizerc. If this feature causes too much grief, I will reimplement the browsercmd stuff again in a later release (but possibly different). Please also tell me whether HTML::Display would be worth a release on its own! 0.22 * The module now requires WWW::Mechanize v0.43, as the internal API of WWW::Mechanize changed. Mixing W::M::S 0.21 or below with W::M v0.43+ will not work as will mixing W::M::S 0.22+ with W::M v0.41- * Added new command "reload", which repeats the last request (intended for testing/modifying server side code) * Altered fillout command - now _all_ fields that aren't predefined via an "autofill" command get asked interactively. Previously fields that already had a value weren't asked. This means that you maybe have to rewrite parts of your scripts if you are using the shell as a testing tool. See t/14* and t/16* for scripts that redefine the interactive asking method to something noninteractive. Field types that do not get asked are : hidden,submit * The "eval" command now takes multiline strings. This is not interesting if you're using the plain shell, as the readline shell dosen't know about about multiline strings, but if you're using the $shell->cmd() feature, it's handy to split your evals over more than one line. 0.21 * Fixed error in one-liner usage * Fixed embarassing errors in 'forms' and 'save' commands * other documentation fixes * The history can now be saved directly to a file * The script can now be saved directly to a file * The generated scripts now have a correct shebang line * Fixed redirect behaviour in generated scripts * Manually filled values (via 'fillout') now get created as 'value' commands 0.20 * made t/00a*.t a TODO test so that CPAN install (silently) works * updated documentation on how to specify custom callbacks from within the shell (having an interpreter with eval rules!) * various documentation fixes * fixed behaviour of "open" with regard to regular expressions * extensive testing of shell behaviour regarding the navigation added * Fixed t/06* when Test::MockObject is not installed 0.19 * Added t/00a*.t to check for a Term::Shell bug to the MANIFEST * renamed the "history" command to "script" * the new "history" command now outputs the "relevant" shell commands * added "versions" command to print out the versions of the installed modules * added "ua" command to easily change the user agent string * added documentation for some more methods * added understanding of "#" as a comment * added a "save" command to save links into files * added "auth" command for basic authentication (suggested by merlyn) * added live test of the auth command against HTTP::Daemon (code provided by merlyn) * added test that 'url' basic authentication also works (http://login:password@example.com) * added convenience "shell" module method : perl -MWWW::Mechanize::Shell -e "shell" * added full end-to-end testing for many commands and their generated scripts * fixed many bugs in the generated scripts * many documentation fixes * Term::ReadLine now gets disabled for the tests * silenced HTML::Form warning for readonly fields 0.18 * No functional changes to v0.17 * Discovered that and documented how file uploads work * Added BUGS section to documentation 0.17 * Fixed a doc bug where "exit" referred to the (nonexistent) "quit" topic (thanks Mark) * Made a test checking the version of Term::Shell and the help summary bug * Fixed t/06*.t - it crashed when Test::MockObject wasn't installed 0.16 2003-04-29 * Changed double quotes around parameters to single quotes to allow for urls like http://mark@foo.com (thanks Mark) * Added tests to check that created scripts at least compile * Made the form fillout more robust by wrapping it in an eval block 0.14 2003-04-14 * Fixed a bad list bug introduced with my unix-browser patch to the options system. Slaven Rezics submitted patch had nothing to do with this, I only grabbed the idea from him but did botch the implementation myself. * Added a test that all options can be set and reset * Reenabled all warnings in the tests * Removed one warning for an unavailable module * Added first part of JavaScript handling : The shell detects when you want to follow a javascript: link, and says that you can't do that. 0.13 2003-04-04 * Slaven Rezic submitted a patch to enable synchronous HTML display under Unix ! Thanks go to Slaven !! All bugs/errors are my fault ! * fixed a crash if the url to the get command was invalid * fixed a crash if a browser was launched without a previous request * added tests for those two crashes * moved example shell from examples/shell.pl to bin/wwwshell.pl 0.12 2003-03-20 * Added a test to check for the behaviour if HTML::TableExtract is not present * silenced warnings in the tests * No changes to the main module except for the version number 0.11 2003-03-18 * Updated the tests so they skip when there is no terminal available (as is the case when the tests are run from cron) * Fixed the inline tests so the synopsis shows again 0.10 2003-03-12 * Added the "table" command to display/dump HTML tables using HTML::TableExtract * Added "table" history * Added tests for history * Brought README file up to date with the suggested support modules * Added example showing off tables * Added proxy support to the shell and the produced scripts * Added documentation on proxy * Added table lister 0.09 2003-03-08 * I should go back and use the web interface. It was made for people like me. 0.08 2003-03-08 * third time's the charm 0.07 2003-03-08 * And again, because I am stupid 0.06 2003-03-08 * bumped version because I uploaded a partial file to CPAN ... 0.05 2003-03-07 * Fixed the dependency on Win32::OLE - the module now handles other environments gracefully * Added some tests for the module fallbacks (these tests need Test::Without::Module) * moved handling over to cvs 0.04 2003-03-01 * reupload as the 0.02 and 0.03 upload was broken 0.02 2003-02-28 * Made the shell much more robust against wrong parameters and internal failures. * Open /foo/ now goes into the Perl code as "follow(/foo/)", as it should be 0.01 2002-11-07 * original version; created by h2xs 1.21 with options -X WWW::Mechanize::Shell ������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/README���������������������������������������������������������������������0000644�0001750�0001750�00000002721�13654075102�015332� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW::Mechanize::Shell - An interactive shell for WWW::Mechanize DESCRIPTION This module implements a www-like shell above WWW::Mechanize and also has the capability to output crude Perl code that recreates the recorded session. Its main use is as an interactive starting point for automating a session through WWW::Mechanize. The cookie support is there, but no cookies are read from your existing browser sessions. See L<HTTP::Cookies> on how to implement reading/writing your current browsers cookies. INSTALLATION This is a Perl module distribution. It should be installed with whichever tool you use to manage your installation of Perl, e.g. any of cpanm . cpan . cpanp -i . Consult https://www.cpan.org/modules/INSTALL.html for further instruction. Should you wish to install this module manually, the procedure is perl Makefile.PL make make test make install REPOSITORY The public repository of this module is L<https://github.com/Corion/WWW-Mechanize-Shell>. SUPPORT The public support forum of this module is L<http://perlmonks.org/>. SEE ALSO L<WWW::Mechanize>,L<WWW::Mechanize::FormFiller>,L<WWW::Mechanize::Firefox> AUTHOR Max Maischein, E<lt>corion@cpan.orgE<gt> Please contact me if you find bugs or otherwise improve the module. More tests are also very welcome ! COPYRIGHT AND LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Copyright (C) 2002-2020 Max Maischein �����������������������������������������������WWW-Mechanize-Shell-0.59/MANIFEST�������������������������������������������������������������������0000644�0001750�0001750�00000002411�13654075102�015577� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������.gitignore bin/banking.postbank.de.mech bin/hotmail.signup.mech bin/wwwshell.pl Changes inc/IO/Catch.pm lib/WWW/Mechanize/Shell.pm LICENSE Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.json META.yml Module meta-data (added by MakeMaker) README README.mkdn t/00-load.t t/00-use.t t/00a-Term-Shell-catch-smry.t t/01-fallback-Win32-OLE.t t/02-fallback-HTML-TableExtract.t t/02-fallback-Pod-Constant.t t/03-documentation.t t/04-history-invariant.t t/05-options.t t/06-valid-output.t t/07-history-items.t t/08-unknown-command.t t/09-invalid-filename.t t/11-browse-without-request.t t/12-comments.t t/13-command-au.t t/14-command-identity.t t/15-history-save.t t/16-form-fillout.t t/17-eval-multiline.t t/18-browser-autosync.t t/19-value-multi.t t/20-restart-without-script.t t/21-autofill-re.t t/22-complete-command.t t/23-check-dumpresponses.t t/24-source-file.t t/25-save-file-nolink.t t/26-form-no-form.t t/27-form_number.t t/27-index.html t/28-cmd-headers.t t/28-cmd-title.t t/28-html-tableextract.t t/29-launch-shell.t t/embedded-WWW-Mechanize-Shell.t t/source.mech xt/99-changes.t xt/99-compile.t xt/99-manifest.t xt/99-minimumversion.t xt/99-pod.t xt/99-synopsis.t xt/99-test-prerequisites.t xt/99-todo.t xt/99-unix-text.t xt/99-versions.t xt/copyright.t xt/meta-lint.t �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/inc/�����������������������������������������������������������������������0000755�0001750�0001750�00000000000�13654075103�015222� 5����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/inc/IO/��������������������������������������������������������������������0000755�0001750�0001750�00000000000�13654075103�015531� 5����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/inc/IO/Catch.pm������������������������������������������������������������0000755�0001750�0001750�00000002363�13654075102�017117� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package IO::Catch; use strict; use Carp qw(croak); =head1 NAME IO::Catch - capture STDOUT and STDERR into global variables =head1 AUTHOR Max Maischein ( corion at cpan.org ) All code ripped from pod2test by M. Schwern =head1 SYNOPSIS # pre-5.8.0's warns aren't caught by a tied STDERR. our ($_STDOUT_, $_STDERR_); tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; tie *STDERR, 'IO::Catch', '_STDERR_' or die $!; # now you can access $main::_STDOUT_ and $_STDERR_ # to see the output. =cut our $VERSION = '0.02'; sub TIEHANDLE { my($class, $var) = @_; croak "Need a variable name to tie to" unless $var; return bless { var => $var }, $class; } sub PRINT { no strict 'refs'; my($self) = shift; ${'main::'.$self->{var}} = "" unless defined ${'main::'.$self->{var}}; ${'main::'.$self->{var}} .= join '', @_; } sub PRINTF { no strict 'refs'; my($self) = shift; my $tmpl = shift; ${'main::'.$self->{var}} = "" unless defined ${'main::'.$self->{var}}; ${'main::'.$self->{var}} .= sprintf $tmpl, @_; } sub OPEN {} # XXX Hackery in case the user redirects sub CLOSE {} # XXX STDERR/STDOUT. This is not the behavior we want. sub READ {} sub READLINE {} sub GETC {} sub BINMODE {} 1; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/LICENSE��������������������������������������������������������������������0000644�0001750�0001750�00000021275�13654075102�015464� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� The Artistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/bin/�����������������������������������������������������������������������0000755�0001750�0001750�00000000000�13654075103�015221� 5����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/bin/wwwshell.pl������������������������������������������������������������0000644�0001750�0001750�00000000271�13654075102�017431� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w use strict; use WWW::Mechanize::Shell; my $shell = WWW::Mechanize::Shell->new("shell"); if (@ARGV) { $shell->source_file( @ARGV ); } else { $shell->cmdloop; }; ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/bin/banking.postbank.de.mech�����������������������������������������������0000644�0001750�0001750�00000000443�13654075102�021677� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������autofill TAN Keep autofill SUBMITPATTERN Keep get "https://banking.postbank.de/anfang.jsp" value Kontonummer 9999999999 value PIN 11111 value FUNCTION ACCOUNTSTATEMENT value TAN "" value SUBMITPATTERN "" fill click LOGIN value CHOICE COMPLETE click SUBMIT forms form 3 click DOWNLOAD history�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.59/bin/hotmail.signup.mech����������������������������������������������������0000644�0001750�0001750�00000000772�13654075102�021025� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������auto Dirty Fixed "" auto FirstName Fixed Cor auto LastName Fixed Blimey auto Gender Fixed m auto PostalCode Fixed 666 auto TimeZone Fixed 1096 auto Month Fixed 2 auto Day Fixed 18 auto Year Fixed 1980 auto SignInName Fixed CorBlimey666 auto Password Fixed BlimeyCor999 auto ConfirmedPassword Fixed BlimeyCor999 auto SecretAnswer Fixed BlimeyCor969 auto ConsentEmail Fixed "" auto ConsentName Fixed "" auto ConsentDemographic Fixed "" get http://www.hotmail.com/ o "/^Sign Up/" form 2 click form 1 bro fill����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������