WWW-Mechanize-Shell-0.55/0000755000175000017500000000000012517112473014444 5ustar corioncorionWWW-Mechanize-Shell-0.55/META.json0000644000175000017500000000250512517112473016067 0ustar corioncorion{ "abstract" : "An interactive shell for WWW::Mechanize", "author" : [ "Max Maischein " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921", "license" : [ "unknown" ], "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", "Hook::LexWrap" : "0.2", "LWP" : "5.69", "Term::Shell" : "0.02", "Test::Harness" : "2.3", "URI::URL" : "0", "WWW::Mechanize" : "1.2", "WWW::Mechanize::FormFiller" : "0.05", "parent" : "0" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "https://github.com/Corion/WWW-Mechanize-Shell" } }, "version" : "0.55" } WWW-Mechanize-Shell-0.55/Changes0000644000175000017500000004013412517112330015731 0ustar corioncorionRevision 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.55 20150426 . Fix one more test against new sprintf() warnings in 5.21+ 0.54 20150426 . 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 20130810 . Add links to repository, contributed by D. Steinbrunner 0.52 20110106 . Fix stupid thinko in test (only affects tests on 5.13+) 0.51 20110105 . 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 20100821 . 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 20100817 + 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 20081109 + 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 20081102 + 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 20071003 + Bump version because of borked CPAN upload, retrying * No need to upgrade 0.45 20071003 * 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 20070707 + Added C 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 20070511 - 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 20070414 - Codeacrobat release - Restore compatibility with WWW::Mechanize 1.22 Thanks to Jörg Meltzer who sent in the patch 0.40 20070117 - 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 20061214 - 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 20030429 - 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 20030414 - 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 20030404 - 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 20030320 - 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 20030318 - 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 20030312 - 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 20030308 - I should go back and use the web interface. It was made for people like me. 0.08 20030308 - third time's the charm 0.07 20030308 - And again, because I am stupid 0.06 20030308 - bumped version because I uploaded a partial file to CPAN ... 0.05 20030307 - 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 20030301 - reupload as the 0.02 and 0.03 upload was broken 0.02 20030228 - 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 Thu Nov 7 23:04:20 2002 - original version; created by h2xs 1.21 with options -X WWW::Mechanize::Shell ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.55/META.yml�������������������������������������������������������������������0000644�0001750�0001750�00000001401�12517112473�015711� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������--- abstract: 'An interactive shell for WWW::Mechanize' author: - 'Max Maischein <corion@cpan.org>' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921' license: unknown 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 Hook::LexWrap: 0.2 LWP: 5.69 Term::Shell: 0.02 Test::Harness: 2.3 URI::URL: 0 WWW::Mechanize: 1.2 WWW::Mechanize::FormFiller: 0.05 parent: 0 resources: repository: https://github.com/Corion/WWW-Mechanize-Shell version: 0.55 ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.55/MANIFEST.SKIP��������������������������������������������������������������0000755�0001750�0001750�00000000316�12517002035�016335� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������\.lwpcookies$ \.cvsignore$ \.releaserc$ blib WWW-Mechanize-Shell-* WWW-Mechanize-Shell-*/ CVS/ .git/ MANIFEST.bak pm_to_blib pm_to_blib.ts cvstest Makefile$ cover_db/ blibdirs.ts perlbug.rep MYMETA t/hook* ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.55/.gitignore�����������������������������������������������������������������0000644�0001750�0001750�00000000223�12517002035�016421� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Makefile Makefile.old *.tar.gz *.bak pm_to_blib blib/ WWW-Mechanize-Shell-* WWW-Mechanize-Shell-*/ .releaserc .lwpcookies CVS MYMETA.* �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.55/inc/�����������������������������������������������������������������������0000755�0001750�0001750�00000000000�12517112473�015215� 5����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.55/inc/IO/��������������������������������������������������������������������0000755�0001750�0001750�00000000000�12517112473�015524� 5����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.55/inc/IO/Catch.pm������������������������������������������������������������0000755�0001750�0001750�00000002416�12517002035�017102� 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. use vars qw($_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 use vars qw($VERSION); $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.55/inc/Test/������������������������������������������������������������������0000755�0001750�0001750�00000000000�12517112473�016134� 5����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.55/inc/Test/HTTP/�������������������������������������������������������������0000755�0001750�0001750�00000000000�12517112473�016713� 5����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.55/inc/Test/HTTP/LocalServer.pm�����������������������������������������������0000755�0001750�0001750�00000007124�12517002035�021471� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������package Test::HTTP::LocalServer; # start a fake webserver, fork, and connect to ourselves use strict; use LWP::Simple; use FindBin; use File::Spec; use File::Temp; use URI::URL qw(); use Carp qw(carp croak); use vars qw($VERSION); $VERSION = '0.50'; =head2 C<Test::HTTP::LocalServer-E<gt>spawn %ARGS> This spawns a new HTTP server. The server will stay running until $server->stop is called. Valid arguments are : html => scalar containing the page to be served file => filename containing the page to be served debug => 1 # to make the spawned server output debug information All served HTML will have the first %s replaced by the current location. The following entries will be removed from C<%ENV>: HTTP_PROXY http_proxy CGI_HTTP_PROXY =cut sub spawn { my ($class,%args) = @_; my $self = { %args }; bless $self,$class; local $ENV{TEST_HTTP_VERBOSE} = 1 if (delete $args{debug}); delete @ENV{qw(HTTP_PROXY http_proxy CGI_HTTP_PROXY)}; $self->{delete} = []; if (my $html = delete $args{html}) { # write the html to a temp file my ($fh,$tempfile) = File::Temp::tempfile(); binmode $fh; print $fh $html or die "Couldn't write tempfile $tempfile : $!"; close $fh; push @{$self->{delete}},$tempfile; $args{file} = $tempfile; }; my ($fh,$logfile) = File::Temp::tempfile(); close $fh; push @{$self->{delete}},$logfile; $self->{logfile} = $logfile; my $web_page = delete $args{file} || ""; #if (defined $web_page) { # $web_page = qq{$web_page} #} else { # $web_page = ""; #}; my $server_file = File::Spec->catfile( $FindBin::Bin,File::Spec->updir,'inc','Test','HTTP','log-server' ); open my $server, qq'$^X "$server_file" "$web_page" "$logfile" |' or die "Couldn't spawn fake server $server_file : $!"; my $url = <$server>; chomp $url; die "Couldn't find fake server url" unless $url; $self->{_fh} = $server; $self->{_server_url} = URI::URL->new($url); $self; }; =head2 C<$server-E<gt>port> This returns the port of the current server. As new instances will most likely run under a different port, this is convenient if you need to compare results from two runs. =cut sub port { carp __PACKAGE__ . "::port called without a server" unless $_[0]->{_server_url}; $_[0]->{_server_url}->port }; =head2 C<$server-E<gt>url> This returns the url where you can contact the server. This url is valid until the C<$server> goes out of scope or you call $server->stop; =cut sub url { $_[0]->{_server_url}->abs }; =head2 C<$server-E<gt>stop> This stops the server process by requesting a special url. =cut sub stop { get( $_[0]->{_server_url} . "quit_server" ); undef $_[0]->{_server_url} }; =head2 C<$server-E<gt>get_output> This stops the server by calling C<stop> and then returns the output of the server process. This output will be a list of all requests made to the server concatenated together as a string. =cut sub get_output { my ($self) = @_; return get( $self->{_server_url} . "get_server_log" ); }; sub DESTROY { $_[0]->stop if $_[0]->{_server_url}; for my $file (@{$_[0]->{delete}}) { unlink $file or warn "Couldn't remove tempfile $file : $!\n"; }; }; =head1 EXPORT None by default. =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) 2003-2007 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::Shell> =cut 1; ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������WWW-Mechanize-Shell-0.55/inc/Test/HTTP/log-server���������������������������������������������������0000755�0001750�0001750�00000007176�12517002035�020731� 0����������������������������������������������������������������������������������������������������ustar �corion��������������������������corion�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������# Thanks to merlyn for nudging me and giving me this snippet! use strict; use HTTP::Daemon; use CGI; $|++; my $d = HTTP::Daemon->new or die; print $d->url, "\n"; my ($filename,$logfile) = @ARGV[0,1]; if ($filename) { open DATA, "< $filename" or die "Couldn't read page '$filename' : $!\n"; }; #open LOG, ">", $logfile # or die "Couldn't create logfile '$logfile' : $!\n"; my $log; my $body = join "", <DATA>; sub debug($) { my $message = $_[0]; $message =~ s!\n!\n#SERVER:!g; warn "#SERVER: $message" if $ENV{TEST_HTTP_VERBOSE}; }; SERVERLOOP: { my $quitserver; while (my $c = $d->accept) { debug "New connection"; while (my $r = $c->get_request) { debug "Request:\n" . $r->as_string; my $location = ($r->uri->path || "/"); my ($link1,$link2) = ('',''); if ($location =~ m!^/link/([^/]+)/(.*)$!) { ($link1,$link2) = ($1,$2); }; my $res; if ($location eq '/get_server_log') { $res = HTTP::Response->new(200, "OK", undef, $log); undef $log; } elsif ( $location eq '/quit_server') { debug "Quitting"; $res = HTTP::Response->new(200, "OK", undef, "quit"); $c->force_last_request; $quitserver = 1; #close LOG; } else { $log .= "Request:\n" . $r->as_string . "\n"; if ($location =~ m!^/redirect/(.*)$!) { $res = HTTP::Response->new(302); $res->header('location', $d->url . $1); } elsif ($location =~ m!^/notfound/(.*)$!) { $res = HTTP::Response->new(404); #$res->header('location', $d->url . $1); } else { my $q = CGI->new($r->uri->query); # Make sticky form fields my ($query,$session,%cat); $query = defined $q->param('query') ? $q->param('query') : "(empty)"; $session = defined $q->param('session') ? $q->param('session') : 1; %cat = map { $_ => 1 } (defined $q->param('cat') ? scalar $q->param('cat') : qw( cat_foo cat_bar )); my @categories = map { $cat{$_} ? "checked" : "" } qw( cat_foo cat_bar cat_baz ); $res = HTTP::Response->new(200, "OK", undef, sprintf($body,$location,$session,$query,@categories)); $res->content_type('text/html'); debug "Request " . ($r->uri->path || "/"); }; }; debug "Response:\n" . $res->as_string; $c->send_response($res); last if $quitserver; } $c->close; undef($c); last SERVERLOOP if $quitserver; } }; END { debug "Server stopped" }; __DATA__ <html> <head> <title>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.55/README0000644000175000017500000000154612517002035015322 0ustar corioncorionWWW/Mechanize/Shell ================================ This is a small shell around WWW::Mechanize that allows interactive exploration of a web page. After you've found your way around the website, you can dump the session as Perl code to replay the session without the shell. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: WWW::Mechanize WWW::Mechanize::FormFiller Term::Shell Hook::LexWrap Nice to have are : Win32::OLE - for automating IE Pod::Constants - for the online help HTML::TableExtract - for extracting stuff out of tables Test::Inline - for the tests COPYRIGHT AND LICENCE You can use this shell under the same terms as Perl itself Copyright (C) 2002,2010 Max Maischein (corion@cpan.org) WWW-Mechanize-Shell-0.55/t/0000755000175000017500000000000012517112473014707 5ustar corioncorionWWW-Mechanize-Shell-0.55/t/28-cmd-title.t0000755000175000017500000000346412517002035017207 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib 'inc'; use IO::Catch; use vars qw($_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.55/t/13-command-au.t0000755000175000017500000000661212517002035017336 0ustar corioncorion#!/usr/bin/perl -w use strict; use FindBin; use lib 'inc'; use IO::Catch; use vars qw( $_STDOUT_ $_STDERR_ ); # 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 => 6; SKIP: { use_ok('WWW::Mechanize::Shell'); eval { require HTTP::Daemon; }; skip "HTTP::Daemon required to test basic authentication",7 if ($@); # We want to be safe from non-resolving local host names delete @ENV{qw(HTTP_PROXY http_proxy CGI_HTTP_PROXY)}; my $user = 'foo'; my $pass = 'bar'; # Now start a fake webserver, fork, and connect to ourselves open SERVER, qq{"$^X" "$FindBin::Bin/401-server" $user $pass |} or die "Couldn't spawn fake server : $!"; sleep 1; # give the child some time my $url = ; chomp $url; die "Couldn't decipher host/port from '$url'" unless $url =~ m!^http://([^/]+)/!; my $host = $1; my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); # First try with an inline username/password my $pwd_url = $url; $pwd_url =~ s!^http://!http://$user:$pass\@!; $pwd_url .= 'thisshouldpass'; diag "get $pwd_url"; $s->cmd( "get $pwd_url" ); diag $s->agent->res->message unless is($s->agent->res->code, 200, "Request with inline credentials gives 200"); is($s->agent->content, "user = 'foo' pass = 'bar'", "Credentials are good"); # Now try without credentials my $bare_url = $url . "thisshouldfail"; diag "get $bare_url"; $s->cmd( "get $bare_url" ); my $code = $s->agent->response->code; my $got_url = $s->agent->uri; if (! ok $code == 401 || $got_url ne $bare_url, "Request without credentials gives 401 (or is hidden by a WWW::Mechanize bug)") { diag "Page location : " . $s->agent->uri; diag $s->agent->res->as_string; }; SKIP: { if ($got_url ne $url) { skip "WWW::Mechanize 1.50 has a bug that doesn't give you a 401 page", 1; } else { like($s->agent->content, '/^auth required /', "Content requests authentication") or diag $s->agent->res->as_string; }; }; # Now try the shell command for authentication $s->cmd( "auth foo bar" ); # WWW::Mechanize breaks the LWP::UserAgent API in a bad, bad way # it even monkeypatches LWP::UserAgent so we have no better way # than to hope for the best :-((( # If it didn't return our expected credentials, we're a victim of # WWW::Mechanize's monkeypatch :-( my @credentials = $s->agent->get_basic_credentials(); if ($credentials[0] ne 'foo') { SKIP: { skip "WWW::Mechanize $WWW::Mechanize::VERSION has buggy implementation/override of ->credentials", 1; }; } else { diag "Credentials are @credentials"; use Data::Dumper; my $a = $s->agent; @credentials = $a->get_basic_credentials(); diag "Credentials are @credentials"; my @real_credentials = LWP::UserAgent::credentials($a,$host,'testing realm'); SKIP: { if ($real_credentials[0] ne $credentials[0]) { skip "WWW::Mechanize credentials() patch breaks LWP::UserAgent credentials()", 1; } else { $s->cmd( "get $url" ); diag $s->agent->res->message unless is($s->agent->res->code, 200, "Request with credentials gives 200"); is($s->agent->content, "user = 'foo' pass = 'bar'", "Credentials are good"); }; }; }; diag "Shutting down test server at $url"; $s->agent->get("${url}exit"); # shut down server }; END { close SERVER; # boom }; WWW-Mechanize-Shell-0.55/t/12-comments.t0000755000175000017500000000214612517002035017137 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib 'inc'; use IO::Catch; use vars qw( @comments $_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 $!; BEGIN { @comments = ( "#", "# a test", "#eval 1", "# eval 1", "## eval 1" )}; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; use Test::More 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.55/t/401-server0000755000175000017500000000263612517002035016444 0ustar corioncorion# Thanks to merlyn for nudging me and giving me this snippet! use strict; use HTTP::Daemon; use LWP::UserAgent; $|++; my $d = HTTP::Daemon->new or die; print $d->url, "\n"; # How many requests do we expect? my ($ex_user,$ex_pass) = @ARGV; my $verbose = $ENV{TEST_HTTP_VERBOSE}; my $done = 0; while (! $done and my $c = $d->accept) { while (my $req = $c->get_request) { if ($verbose) { warn "# Request URI: " . $req->url->path; my @lines = split "\n",$req->as_string; warn "# $_\n" for @lines; }; my $res; my ($user,$pass); if ($req->url->path eq '/exit') { $done = 1; $res = HTTP::Response->new(200, "OK", undef, "done"); } elsif ( ($user, $pass) = $req->authorization_basic and $user eq $ex_user and $pass eq $ex_pass) { $res = HTTP::Response->new(200, "OK", undef, "user = '$user' pass = '$pass'"); } else { warn "# User : '$user' Password : '$pass'\n" if $verbose; $res = HTTP::Response->new(401, "Auth Required", undef, "auth required ($user/$pass)"); $res->www_authenticate("Basic realm=\"testing realm\""); }; if ($verbose) { warn "---\n"; my @lines = split "\n",$res->as_string; warn "# $_\n" for @lines; }; $c->send_response($res); } $c->close; undef($c); }; WWW-Mechanize-Shell-0.55/t/08-unknown-command.t0000755000175000017500000000147312517002035020434 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.55/t/28-cmd-headers.t0000755000175000017500000000451712517002035017501 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib 'inc'; use IO::Catch; use vars qw($_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.55/t/99-versions.t0000644000175000017500000000232212517002035017172 0ustar corioncorion#!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; BEGIN { eval 'use File::Slurp; 1'; if ($@) { plan skip_all => "File::Slurp needed for testing"; exit 0; }; }; plan 'no_plan'; my $last_version = undef; sub check { return if (! m{blib/script/}xms && ! m{\.pm \z}xms); 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) { if (!defined $last_version) { $last_version = shift @version_lines; diag "Checking for $last_version"; pass($_); } else { is($line, $last_version, $_); } } } find({wanted => \&check, no_chdir => 1}, 'blib'); if (! defined $last_version) { fail('Failed to find any files with $VERSION'); } WWW-Mechanize-Shell-0.55/t/15-history-save.t0000755000175000017500000000320012517002035017742 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 => 7; # Disable all ReadLine functionality $ENV{PERL_RL} = 0; use_ok('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.55/t/99-changes.t0000644000175000017500000000127512517002035016740 0ustar corioncorion#!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 my $module = 'WWW::Mechanize::Shell'; (my $file = $module) =~ s!::!/!g; require "$file.pm"; my $version = sprintf '%0.2f', $module->VERSION; diag "Checking for version " . $version; my $changes = do { local $/; open my $fh, 'Changes' or die $!; <$fh> }; ok $changes =~ /^(.*$version.*)$/m, "We find version $version"; my $changes_line = $1; ok $changes_line =~ /$version\s+20\d{6}/, "We find a release date on the same line" or diag $changes_line; WWW-Mechanize-Shell-0.55/t/27-form_number.t0000755000175000017500000000150012517002035017624 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib 'inc'; use IO::Catch; use vars qw($_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.55/t/21-autofill-re.t0000755000175000017500000000161712517002035017537 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib 'inc'; use File::Temp qw( tempfile ); use IO::Catch; use vars qw($_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.55/t/11-browse-without-request.t0000755000175000017500000000072212517002035021777 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.55/t/02-fallback-Pod-Constant.t0000644000175000017500000000165012517002035021353 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.55/t/23-check-dumpresponses.t0000755000175000017500000000163612517002035021301 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib 'inc'; use IO::Catch; use Test::HTTP::LocalServer; use vars qw($_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.55/t/19-value-multi.t0000755000175000017500000000444412517002035017570 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.55/t/18-browser-autosync.t0000755000175000017500000000346012517112261020651 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 $!; use vars qw( %tests ); BEGIN { %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'] }, ) }; use Test::More tests => scalar (keys %tests) +1; SKIP: { BEGIN { # Disable all ReadLine functionality $ENV{PERL_RL} = 0; use_ok('WWW::Mechanize::Shell'); eval { require HTTP::Daemon; }; skip "HTTP::Daemon required to test browser synchronisation",(scalar keys %tests)*6 if ($@); use lib 'inc'; require Test::HTTP::LocalServer; # from inc delete @ENV{qw(HTTP_PROXY http_proxy CGI_HTTP_PROXY)}; }; my $browser_synced; { no warnings 'redefine'; *WWW::Mechanize::Shell::sync_browser = sub { $browser_synced++; }; }; sub sync_ok { my %args = @_; my $name = $args{name}; my $count = $args{count}; my (@commands) = @{$args{commands}}; my $server = Test::HTTP::LocalServer->spawn(); 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; $server->stop; }; for my $cmd (sort keys %tests) { sync_ok( name => $cmd, %{$tests{$cmd}} ); }; }; WWW-Mechanize-Shell-0.55/t/01-fallback-Win32-OLE.t0000644000175000017500000000106712517002035020362 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.55/t/source.mech0000644000175000017500000000002612517002035017033 0ustar corioncorion# a test file content WWW-Mechanize-Shell-0.55/t/25-save-file-nolink.t0000755000175000017500000000220112517002035020451 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib 'inc'; use IO::Catch; use Test::HTTP::LocalServer; use vars qw($_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.55/t/09-invalid-filename.t0000755000175000017500000000147712517002035020532 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.55/t/24-source-file.t0000755000175000017500000000224712517002035017534 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib 'inc'; use IO::Catch; use Test::HTTP::LocalServer; use vars qw($_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{PAGER} if $ENV{PAGER}; $ENV{PERL_HTML_DISPLAY_CLASS}="HTML::Display::Dump"; 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( 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.55/t/99-todo.t0000755000175000017500000000202712517002035016274 0ustar corioncorionuse 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. my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib, 'bin')); 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.55/t/99-unix-text.t0000755000175000017500000000140412517002035017272 0ustar corioncorionuse Test::More; # Check that all released module files are in # UNIX text format use File::Spec; use File::Find; use strict; my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib, 'bin')); 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 F, "< $filename" or die "Couldn't open '$filename' : $!\n"; binmode F; my $content = ; 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 F; }; WWW-Mechanize-Shell-0.55/t/06-valid-output.t0000755000175000017500000000746712517002035017765 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib 'inc'; use IO::Catch; use Test::More (); use File::Temp qw( tempfile ); use WWW::Mechanize::Link; # 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; }; use vars qw( %tests ); BEGIN { %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'; }; }; use Test::More tests => scalar (keys %tests)*2 +1; BEGIN { use_ok('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.55/t/28-html-tableextract.t0000755000175000017500000000367512517002035020755 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.55/t/98-bin.t0000755000175000017500000000144412517002035016100 0ustar corioncorionuse strict; use Test::More; # Check that all programs below bin/ compile : use File::Find; use File::Spec; my $blib = File::Spec->catfile(qw(blib lib)); my @files; my @skip; opendir DIST,'.'; my @manifest = grep { /^manifest.skip$/i } (readdir DIST); closedir DIST; if (-f $manifest[0]) { open F, "<$manifest[0]" or die "Couldn't open $manifest[0] : $!"; @skip = map { s/\s*$//; $_ } ; close F; }; find(\&wanted, "bin"); plan tests => scalar @files; foreach my $file (@files) { my $result = `$^X "-I$blib" -c "$file" 2>&1`; chomp $result; is( $result, "$file syntax OK", "Script '$file' compiles"); } sub wanted { my $name = $File::Find::name; push @files, $name if -f $_ and /\.pl$/ and not grep { $name =~ /$_/ } @skip; $File::Find::prune = 1 if -d $_ and $_ ne '.'; } WWW-Mechanize-Shell-0.55/t/99-pod.t0000644000175000017500000000123212517002035016103 0ustar corioncorionuse 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; }; 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, 'bin')); 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.55/t/20-restart-without-script.t0000755000175000017500000000101112517002035021766 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 -Ilib -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.55/t/03-documentation.t0000644000175000017500000000165112517002035020160 0ustar corioncorionuse strict; use FindBin; use vars qw( @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.55/t/00-use.t0000644000175000017500000000514212517002035016077 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"); 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.55/t/99-manifest.t0000755000175000017500000000154612517002035017142 0ustar corioncorionuse 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 ; for my $file (@files) { ok(-f $file, "$file exists"); open F, "<$file" or die "Couldn't open $file : $!"; my @lines = ; 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 }; }; close F; }; WWW-Mechanize-Shell-0.55/t/26-form-no-form.t0000755000175000017500000000212412517002035017631 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib 'inc'; use IO::Catch; use vars qw($_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.55/t/02-fallback-HTML-TableExtract.t0000755000175000017500000000214412517002035022170 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"); like( $warned, qr'^HTML\W+TableExtract\.pm did not return a true value', "Missing HTML::TableExtract raises warning"); }; WWW-Mechanize-Shell-0.55/t/27-index.html0000644000175000017500000000264212517002035017126 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.55/t/14-command-identity.t0000755000175000017500000003273112517002035020564 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib 'inc'; use FindBin; use IO::Catch; use File::Temp qw( tempfile ); use vars qw( %tests $_STDOUT_ $_STDERR_ ); use URI::URL; use LWP::Simple; # 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; BEGIN { %tests = ( autofill => { requests => 2, lines => [ 'get %s', 'autofill query Fixed foo', 'autofill cat Keep', 'fillout', 'submit' ], location => qr'^%s/formsubmit\?session=1&query=foo&cat=cat_foo&cat=cat_bar$'}, 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 cat Keep', 'get %s', 'fillout', 'eval $self->agent->current_form->value("session")', 'submit', 'content', ], location => qr'^%s/formsubmit\?session=20030511&query=\(empty\)&cat=cat_foo&cat=cat_bar$' }, eval_multiline => { requests => 2, lines => [ 'get %s', 'autofill query Keep', 'autofill cat Keep', 'fillout', 'submit', 'eval "Hello World ", "from ",$self->agent->uri', 'content' ], location => qr'^%s/formsubmit\?session=1&query=\(empty\)&cat=cat_foo&cat=cat_bar$' }, form_name => { requests => 2, lines => [ 'get %s','form f','submit' ], location => qr'^%s/formsubmit\?session=1&query=\(empty\)&cat=cat_foo&cat=cat_bar$' }, form_num => { requests => 2, lines => [ 'get %s','form 1','submit' ], location => qr'^%s/formsubmit\?session=1&query=\(empty\)&cat=cat_foo&cat=cat_bar$' }, formfiller_chars => { requests => 2, lines => [ 'eval srand 0', 'autofill cat Keep', 'autofill query Random::Chars size 5 set alpha', 'get %s', 'fillout','submit','content' ], location => qr'^%s/formsubmit\?session=1&query=[a-zA-Z]{5}&cat=cat_foo&cat=cat_bar$' }, formfiller_date => { requests => 2, lines => [ 'eval srand 0', 'autofill cat Keep', 'autofill query Random::Date string %%Y%%m%%d', 'get %s', 'fillout','submit','content' ], location => qr'^%s/formsubmit\?session=1&query=\d{8}&cat=cat_foo&cat=cat_bar$' }, formfiller_default => { requests => 2, lines => [ 'autofill query Default foo', 'autofill cat Keep', 'get %s', 'fillout','submit','content' ], location => qr'^%s/formsubmit\?session=1&query=\(empty\)&cat=cat_foo&cat=cat_bar$' }, formfiller_fixed => { requests => 2, lines => [ 'autofill query Fixed foo', 'autofill cat Keep', 'get %s', 'fillout','submit','content' ], location => qr'^%s/formsubmit\?session=1&query=foo&cat=cat_foo&cat=cat_bar$' }, formfiller_keep => { requests => 2, lines => [ 'autofill query Keep', 'autofill cat Keep', 'get %s', 'fillout','submit','content' ], location => qr'^%s/formsubmit\?session=1&query=\(empty\)&cat=cat_foo&cat=cat_bar' }, formfiller_random => { requests => 2, lines => [ 'autofill query Random foo', 'autofill cat Keep', 'get %s', 'fillout','submit','content' ], location => qr'^%s/formsubmit\?session=1&query=foo&cat=cat_foo&cat=cat_bar' }, formfiller_re => { requests => 2, lines => [ 'eval srand 0', 'autofill cat Keep', 'autofill /qu/ Random::Date string %%Y%%m%%d', 'get %s', 'fillout','submit','content' ], location => qr'^%s/formsubmit\?session=1&query=\d{8}&cat=cat_foo&cat=cat_bar' }, formfiller_word => { requests => 2, lines => [ 'eval srand 0', 'autofill cat Keep', 'autofill query Random::Word size 1', 'get %s', 'fillout','submit','content' ], location => qr'^%s/formsubmit\?session=1&query=\w+&cat=cat_foo&cat=cat_bar' }, 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\?session=1&query=foo&submit=Go&cat=cat_foo&cat=cat_bar' }, get_value_submit => { requests => 2, lines => [ 'get %s','value query foo', 'submit' ], location => qr'^%s/formsubmit\?session=1&query=foo&cat=cat_foo&cat=cat_bar' }, get_value2_submit => { requests => 2, lines => [ 'get %s', 'value query foo', 'value session 2', 'submit' ], location => qr'^%s/formsubmit\?session=2&query=foo&cat=cat_foo&cat=cat_bar' }, 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', 'get %s', 'fillout', 'submit', 'content' ], location => qr'^%s/formsubmit\?session=foo&query=bar&cat=cat_foo&cat=cat_bar$' }, open_parm => { requests => 2, lines => [ 'get %s','open 0','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\?session=1&query=\(empty\)&cat=cat_foo&cat=cat_bar$' }, tick_all => { requests => 2, lines => [ 'get %s','tick cat','submit','content' ], location => qr'^%s/formsubmit\?session=1&query=\(empty\)&cat=cat_foo&cat=cat_bar&cat=cat_baz$' }, 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\?session=1&query=\(empty\)&cat=cat_bar$' }, untick_all => { requests => 2, lines => [ 'get %s','untick cat','submit','content' ], location => qr'^%s/formsubmit\?session=1&query=\(empty\)$' }, ); 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; }; }; }; use Test::More tests => 1 + (scalar keys %tests)*8; 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_ok('WWW::Mechanize::Shell'); }; SKIP: { diag "Loading HTTP::Daemon"; eval { require HTTP::Daemon; }; skip "HTTP::Daemon required to test script/code identity",(scalar keys %tests)*8 if ($@); # require Test::HTTP::LocalServer; # from inc use Test::HTTP::LocalServer; # from inc # We want to be safe from non-resolving local host names delete @ENV{qw(HTTP_PROXY http_proxy CGI_HTTP_PROXY)}; use vars qw( $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]->(); #}; }; diag "Spawning local test server"; my $server = Test::HTTP::LocalServer->spawn(); diag sprintf "on port %s", $server->port; require LWP::UserAgent; my $lwp_useragent_request = *LWP::UserAgent::request{CODE}; 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}, $url; $result_location = qr{$result_location}; { no warnings 'redefine'; *LWP::UserAgent::request = $lwp_useragent_request; }; 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"); 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_output; # 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_output; diag $script; skip "Script $name didn't compile", 2; }; my ($output); my $command = qq("$^X" -Iblib/lib "$tempname" 2>&1); $output = `$command`; is( $output, $code_output, "Output of $name is identical" ) or diag "Script:\n$script"; my $script_requests = $server->get_output; $code_requests =~ s!\b$code_port\b!$script_port!smg; 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.55/t/29-launch-shell.t0000755000175000017500000000121012517002035017670 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, "-Iblib/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.55/t/16-form-fillout.t0000755000175000017500000010157512517002035017743 0ustar corioncorion#!/usr/bin/perl -w use strict; use FindBin; use lib 'inc'; use IO::Catch; use File::Temp qw( tempfile ); use vars qw( %tests $_STDOUT_ $_STDERR_ ); use URI::URL; use LWP::Simple; # 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 $!; BEGIN { %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' }, ); }; use Test::More tests => 1 + (scalar keys %tests)*6; BEGIN { delete $ENV{PAGER}; $ENV{PERL_RL} = 0; use_ok('WWW::Mechanize::Shell'); }; SKIP: { # Disable all ReadLine functionality my $HTML = do { local $/; }; eval { require HTTP::Daemon; }; skip "HTTP::Daemon required to test script/code identity",(scalar keys %tests)*6 if ($@); require Test::HTTP::LocalServer; # from inc # 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_output; 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`; is( $output, $code_output, "Output of $name is identical" ) or diag "Script:\n$script"; my $script_requests = $script_server->get_output; $code_requests =~ s!\b$code_port\b!$script_port!smg; is($code_requests,$script_requests,"$name produces identical queries"); }; 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.55/t/17-eval-multiline.t0000755000175000017500000000207412517002035020246 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib 'inc'; use IO::Catch; use File::Temp qw( tempfile ); use vars qw($_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.55/t/04-history-invariant.t0000755000175000017500000000376712517002035021017 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 $!; use vars qw( @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.55/t/22-complete-command.t0000755000175000017500000000121412517002035020532 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.55/t/00a-Term-Shell-catch-smry.t0000755000175000017500000000264312517002035021476 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; use vars qw( $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.55/t/07-history-items.t0000755000175000017500000000675212517002035020145 0ustar corioncorion#!/usr/bin/perl -w use strict; use lib 'inc'; use IO::Catch; use File::Temp qw( tempfile ); use WWW::Mechanize::Link; # pre-5.8.0's warns aren't caught by a tied STDERR. tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; use vars qw( %tests ); BEGIN { # Disable all ReadLine functionality $ENV{PERL_RL} = 0; %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'; ; }; }; use Test::More 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.55/t/05-options.t0000755000175000017500000000256512517002035017014 0ustar corioncorion#!/usr/bin/perl -w use strict; use vars qw( @options ); BEGIN { @options = qw( autosync autorestart watchfiles cookiefile dumprequests dumpresponses verbose warnings ); }; use Test::More tests => scalar @options*4 +1+4; SKIP: { BEGIN { $ENV{PERL_RL} = 0; use_ok('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.55/bin/0000755000175000017500000000000012517112473015214 5ustar corioncorionWWW-Mechanize-Shell-0.55/bin/wwwshell.pl0000644000175000017500000000027112517002035017415 0ustar corioncorion#!/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.55/bin/hotmail.signup.mech0000644000175000017500000000077212517002035021011 0ustar corioncorionauto 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 fillWWW-Mechanize-Shell-0.55/bin/banking.postbank.de.mech0000644000175000017500000000044312517002035021663 0ustar corioncorionautofill 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 historyWWW-Mechanize-Shell-0.55/lib/0000755000175000017500000000000012517112473015212 5ustar corioncorionWWW-Mechanize-Shell-0.55/lib/WWW/0000755000175000017500000000000012517112473015676 5ustar corioncorionWWW-Mechanize-Shell-0.55/lib/WWW/Mechanize/0000755000175000017500000000000012517112473017601 5ustar corioncorionWWW-Mechanize-Shell-0.55/lib/WWW/Mechanize/Shell.pm0000644000175000017500000014035112517112342021205 0ustar corioncorionpackage 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; use vars qw( $VERSION @EXPORT %munge_map ); $VERSION = '0.55'; @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 on how to implement reading/writing your current browsers cookies. =head2 Cnew %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 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 parameter can be passed to the constructor : rcfile => '.myapprc', =cut sub init { my ($self) = @_; my ($name,%args) = @{$self->{API}{args}}; $self->{agent} = WWW::Mechanize->new(); $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(); # 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-Erelease_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-Esource_file FILENAME> The C 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 () { $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-Edisplay_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-Eprint_paged LIST> Prints the text in LIST using C<$ENV{PAGER}>. If C<$ENV{PAGER}> is empty, prints directly to C. Most of this routine comes from the C 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->res->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-Ehistory> 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-Escript> 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-Estatus> C is called for status updates. =cut sub status { my $self = shift; print join "", @_; }; =head2 C<$shell-Edisplay FILENAME LINES> C is called to output listings, currently from the C and C 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 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 server to serve the file, you can use the C 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 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, but a fix is in the works. Until then, you can re-enable the dynamic online help by patching C : Remove the three lines my $smry = exists $o->{handlers}{$h}{smry} ? $o->summary($h) : "undocumented"; in C and replace them by my $smry = $o->summary($h); The shell works without this patch and the online help is still available through C =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 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, or if not possible, code the extraction in Perl, either in the final script or through C 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 from HTML::Parser to XML::XMLlib or maybe easier, by tacking Class::XPath onto an HTML tree) =item * Add C as a command ? =item * Optionally silence the HTML::Parser / HTML::Forms warnings about invalid HTML. =back =head1 EXPORT The routine C 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. =head1 SUPPORT The public support forum of this module is L. =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,2010 Max Maischein =head1 AUTHOR Max Maischein, Ecorion@cpan.orgE Please contact me if you find bugs or otherwise improve the module. More tests are also very welcome ! =head1 SEE ALSO L,L,L =cut WWW-Mechanize-Shell-0.55/MANIFEST0000644000175000017500000000223712517112473015601 0ustar corioncorion.gitignore bin/banking.postbank.de.mech bin/hotmail.signup.mech bin/wwwshell.pl Changes inc/IO/Catch.pm inc/Test/HTTP/LocalServer.pm inc/Test/HTTP/log-server lib/WWW/Mechanize/Shell.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.json META.yml Module meta-data (added by MakeMaker) README 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/401-server t/98-bin.t t/99-changes.t t/99-manifest.t t/99-pod.t t/99-todo.t t/99-unix-text.t t/99-versions.t t/source.mech WWW-Mechanize-Shell-0.55/Makefile.PL0000644000175000017500000000215512517002035016411 0ustar corioncorionuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'WWW::Mechanize::Shell', 'VERSION_FROM' => 'lib/WWW/Mechanize/Shell.pm', # finds $VERSION 'PREREQ_PM' => {'Term::Shell' => 0.02, 'parent' => 0, 'URI::URL' => 0.00, 'Test::Harness' => 2.30, 'LWP' => 5.69, 'WWW::Mechanize' => 1.20, 'WWW::Mechanize::FormFiller' => 0.05, 'Hook::LexWrap' => 0.20, 'HTML::Display' => 0, 'HTML::TokeParser::Simple' => 2.0, }, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/WWW/Mechanize/Shell.pm', # retrieve abstract from module AUTHOR => 'Max Maischein ') : ()), META_MERGE => { resources => { repository => 'https://github.com/Corion/WWW-Mechanize-Shell', }, }, ); # To make Test::Prereq happy 1;