WWW-Mechanize-Shell-0.62/t/28-cmd-headers.t 0000755 0001750 0001750 00000004510 14456560526 017512 0 ustar corion corion #!/usr/bin/perl -w
use strict;
use lib './inc';
use IO::Catch;
our $_STDOUT_;
tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!;
# Disable all ReadLine functionality
$ENV{PERL_RL} = 0;
delete $ENV{PAGER}
if $ENV{PAGER};
$ENV{PERL_HTML_DISPLAY_CLASS}="HTML::Display::Dump";
use Test::More tests => 8;
use_ok('WWW::Mechanize::Shell');
my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef );
isa_ok $s, 'WWW::Mechanize::Shell';
sub cleanup() {
# clean up $_STDOUT_ so it fits on one line
#diag $_STDOUT_;
$_STDOUT_ =~ s/[\r\n]+/|/g;
$_STDOUT_ =~ s!(?<=:)(\s+)!(">" x (length($1)/2))!eg;
};
SKIP: {
$s->agent->{base} = 'http://example.com';
$s->agent->update_html(<
An HTML page
(H1.1)
(H2)
(H3.1)
(H3.2)
(H4)
(H1.2)
(H5)
Some spaces before this
A newline in
this
HTML
$s->cmd('headers');
cleanup;
is($_STDOUT_,"h1:(H1.1)|h2:>(H2)|h3:>>(H3.1)|h3:>>(H3.2)|h4:>>>(H4)|h1:(H1.2)|h5:>>>>(H5)|h1:|h1:Some spaces before this|h1:A newline in this|h2:>|h3:>>|", "The default works");
undef $_STDOUT_;
$s->cmd('headers 12345');
cleanup;
is($_STDOUT_,"h1:(H1.1)|h2:>(H2)|h3:>>(H3.1)|h3:>>(H3.2)|h4:>>>(H4)|h1:(H1.2)|h5:>>>>(H5)|h1:|h1:Some spaces before this|h1:A newline in this|h2:>|h3:>>|", "Explicitly specifying the default works as well");
undef $_STDOUT_;
$s->cmd('headers 1');
cleanup;
is($_STDOUT_,"h1:(H1.1)|h1:(H1.2)|h1:|h1:Some spaces before this|h1:A newline in this|", "H1 headers works as well");
undef $_STDOUT_;
$s->cmd('headers 23');
cleanup;
is($_STDOUT_,"h2:>(H2)|h3:>>(H3.1)|h3:>>(H3.2)|h2:>|h3:>>|", "Restricting to a subset works too");
undef $_STDOUT_;
$s->cmd('headers 25');
cleanup;
is($_STDOUT_,"h2:>(H2)|h5:>>>>(H5)|h2:>|", "A noncontingous subset as well");
undef $_STDOUT_;
$s->cmd('headers 52');
cleanup;
is($_STDOUT_,"h2:>(H2)|h5:>>>>(H5)|h2:>|", "Even in a weirdo order");
undef $_STDOUT_;
};
WWW-Mechanize-Shell-0.62/t/22-complete-command.t 0000755 0001750 0001750 00000001214 14456560526 020552 0 ustar corion corion #!/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.62/t/26-form-no-form.t 0000755 0001750 0001750 00000002120 14456560526 017645 0 ustar corion corion #!/usr/bin/perl -w
use strict;
use lib './inc';
use IO::Catch;
our ($_STDOUT_, $_STDERR_);
tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!;
tie *STDERR, 'IO::Catch', '_STDERR_' or die $!;
use Test::More tests => 4;
# Disable all ReadLine functionality
$ENV{PERL_RL} = 0;
delete $ENV{PAGER}
if $ENV{PAGER};
$ENV{PERL_HTML_DISPLAY_CLASS}="HTML::Display::Dump";
my @warnings;
use_ok('WWW::Mechanize::Shell');
my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef );
{ no warnings qw'redefine once';
*WWW::Mechanize::Shell::status = sub {};
};
$s->agent->{base} = 'http://www.google.com/';
$s->agent->update_html("No form here\n");
eval {
$s->cmd("form foo");
};
is($@, '', "Can execute 'form' for a page without forms");
is($_STDOUT_,"There is no form on this page.\n","Message was printed");
is($_STDERR_,undef,"No warnings printed");
#$_STDOUT_ = undef;
#$_STDERR_ = undef;
#$s->cmd("save /does-not-exist/");
#is($_STDOUT_,"No match for /(?-xism:does-not-exist)/.\n","save RE error message");
#is($_STDERR_,undef,"No warnings");
WWW-Mechanize-Shell-0.62/t/02-fallback-Pod-Constant.t 0000644 0001750 0001750 00000001650 14456560526 021373 0 ustar corion corion use 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.62/t/16-form-fillout.t 0000755 0001750 0001750 00000102120 14456560526 017746 0 ustar corion corion #!/usr/bin/perl -w
use strict;
use FindBin;
use Test::More;
use File::Temp qw( tempfile );
our ($_STDOUT_, $_STDERR_ );
use URI::URL;
use Test::HTTP::LocalServer;
use lib './inc';
use IO::Catch;
# pre-5.8.0's warns aren't caught by a tied STDERR.
$SIG{__WARN__} = sub { $main::_STDERR_ .= join '', @_; };
tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!;
tie *STDERR, 'IO::Catch', '_STDERR_' or die $!;
our %tests = (
interactive_script_creation => { requests => 2,
lines => [ 'eval @::list=qw(1 2 3 4 5 6 7 8 9 10 foo NY 11 DE 13 V 15 16 2038-01-01)',
'eval
no warnings qw"once redefine";
*WWW::Mechanize::FormFiller::Value::Ask::ask_value = sub {
#warn "Filled out ",$_[1]->name;
my $value=shift @::list || "empty";
push @{$_[0]->{shell}->{answers}}, [ $_[1]->name, $value ];
$value
}',
'get %s',
'fillout',
'submit',
'content' ],
location => '%sgift_card/alphasite/www/cgi-bin/giftcard.cgi/checkout_process' },
);
plan tests => (scalar keys %tests)*6;
BEGIN {
delete $ENV{PAGER};
$ENV{PERL_RL} = 0;
};
use WWW::Mechanize::Shell;
SKIP: {
# Disable all ReadLine functionality
my $HTML = do { local $/; };
# We want to be safe from non-resolving local host names
delete @ENV{qw(HTTP_PROXY http_proxy CGI_HTTP_PROXY)};
my $actual_requests;
{
no warnings 'redefine';
my $old_request = *WWW::Mechanize::request{CODE};
*WWW::Mechanize::request = sub {
$actual_requests++;
goto &$old_request;
};
*WWW::Mechanize::Shell::status = sub {};
};
for my $name (sort keys %tests) {
$_STDOUT_ = '';
undef $_STDERR_;
$actual_requests = 0;
my @lines = @{$tests{$name}->{lines}};
my $requests = $tests{$name}->{requests};
my $server = Test::HTTP::LocalServer->spawn( html => $HTML );
my $code_port = $server->port;
my $result_location = sprintf $tests{$name}->{location}, $server->url;
my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef );
for my $line (@lines) {
no warnings;
$line = sprintf $line, $server->url;
$s->cmd($line);
};
$s->cmd('eval $self->agent->uri');
my $code_output = $_STDOUT_;
diag join( "\n", $s->history )
unless is($s->agent->uri,$result_location,"Shell moved to the specified url for $name");
is($_STDERR_,undef,"Shell produced no error output for $name");
is($actual_requests,$requests,"$requests requests were made for $name");
my $code_requests = $server->get_log;
my $script_server = Test::HTTP::LocalServer->spawn(html => $HTML);
my $script_port = $script_server->port;
# Modify the generated Perl script to match the new? port
my $script = join "\n", $s->script;
s!\b$code_port\b!$script_port!smg for ($script, $code_output);
undef $s;
# Write the generated Perl script
my ($fh,$tempname) = tempfile();
print $fh $script;
close $fh;
my ($compile) = `$^X -c "$tempname" 2>&1`;
chomp $compile;
unless (is($compile,"$tempname syntax OK","$name compiles")) {
$script_server->stop;
diag $script;
ok(0, "Script $name didn't compile" );
ok(0, "Script $name didn't compile" );
} else {
my ($output);
my $command = qq($^X -Ilib "$tempname" 2>&1);
$output = `$command`;
$output =~ s!^Cookie:.*$!Cookie: !smg; # cookies get re-ordered, sometimes
$code_output =~ s!^Cookie:.*$!Cookie: !smg; # cookies get re-ordered, sometimes
is( $output, $code_output, "Output of $name is identical" )
or diag "Script:\n$script";
my $script_requests = $script_server->get_log;
$code_requests =~ s!\b$code_port\b!$script_port!smg;
$code_requests =~ s!^Cookie:.*$!Cookie: !smg; # cookies get re-ordered, sometimes
$script_requests =~ s!^Cookie:.*$!Cookie: !smg; # cookies get re-ordered, sometimes
is($code_requests,$script_requests,"$name produces identical queries")
or diag $script;
};
unlink $tempname
or diag "Couldn't remove tempfile '$name' : $!";
};
unlink $_ for (<*.save_log_server_test.tmp>);
};
__DATA__
- Gift Cards
Gift Card
Lorem ipsum dolor sit amet, consectetuer adipiscing elit, sed diam nonummy nibh euismod tincidunt ut laoreet dolore magna aliquam erat volutpat. Ut wisi enim ad minim veniam, quis nostrud exerci tation ullamcorper suscipit lobortis nisl ut aliquip ex ea commodo consequat. Duis autem vel eum iriure dolor in hendrerit in vulputate velit esse molestie consequat, vel illum dolore eu feugiat nulla facilisis at vero eros et accumsan et iusto odio dignissim qui blandit praesent
luptatum zzril delenit augue duis dolore te feugait nulla facilisi. Lorem ipsum dolor sit amet, consectetuer adipiscing elit, sed diam nonummy nibh euismod tincidunt ut laoreet dolore magna aliquam erat volutpat. Ut wisi enim ad minim veniam, quis nostrud exerci tation ullamcorper suscipit lobortis nisl ut aliquip ex ea commodo consequat.
WWW-Mechanize-Shell-0.62/README.mkdn 0000644 0001750 0001750 00000045605 14456560526 016276 0 ustar corion corion
[](https://travis-ci.org/Corion/WWW-Mechanize-Shell)
[](https://ci.appveyor.com/project/Corion/WWW-Mechanize-Shell)
# NAME
WWW::Mechanize::Shell - An interactive shell for WWW::Mechanize
# SYNOPSIS
From the command line as
perl -MWWW::Mechanize::Shell -eshell
or alternatively as a custom shell program via :
#!/usr/bin/perl -w
use strict;
use WWW::Mechanize::Shell;
my $shell = WWW::Mechanize::Shell->new("shell");
if (@ARGV) {
$shell->source_file( @ARGV );
} else {
$shell->cmdloop;
};
# DESCRIPTION
This module implements a www-like shell above WWW::Mechanize
and also has the capability to output crude Perl code that recreates
the recorded session. Its main use is as an interactive starting point
for automating a session through WWW::Mechanize.
The cookie support is there, but no cookies are read from your existing
browser sessions. See [HTTP::Cookies](https://metacpan.org/pod/HTTP%3A%3ACookies) on how to implement reading/writing
your current browsers cookies.
## `WWW::Mechanize::Shell->new %ARGS`
This is the constructor for a new shell instance. Some of the options
can be passed to the constructor as parameters.
By default, a file `.mechanizerc` (respectively `mechanizerc` under Windows)
in the users home directory is executed before the interactive shell loop is
entered. This can be used to set some defaults. If you want to supply a different
filename for the rcfile, the `rcfile` parameter can be passed to the constructor :
rcfile => '.myapprc',
- **agent**
my $shell = WWW::Mechanize::Shell->new(
agent => WWW::Mechanize::Chrome->new(),
);
Pass in a premade custom user agent. This object must be compatible to
[WWW::Mechanize](https://metacpan.org/pod/WWW%3A%3AMechanize). Use this feature from the command line as
perl -Ilib -MWWW::Mechanize::Chrome \
-MWWW::Mechanize::Shell \
-e"shell(agent => WWW::Mechanize::Chrome->new())"
## `$shell->release_agent`
Since the shell stores a reference back to itself within the
WWW::Mechanize instance, it is necessary to break this
circular reference. This method does this.
## `$shell->source_file FILENAME`
The `source_file` method executes the lines of FILENAME
as if they were typed in.
$shell->source_file( $filename );
## `$shell->display_user_warning`
All user warnings are routed through this routine
so they can be rerouted / disabled easily.
## `$shell->print_paged LIST`
Prints the text in LIST using `$ENV{PAGER}`. If `$ENV{PAGER}`
is empty, prints directly to `STDOUT`. Most of this routine
comes from the `perldoc` utility.
## `$shell->link_text LINK`
Returns a meaningful text from a WWW::Mechanize::Link object. This is (in order of
precedence) :
$link->text
$link->name
$link->url
## `$shell->history`
Returns the (relevant) shell history, that is, all commands
that were not solely for the information of the user. The
lines are returned as a list.
print join "\n", $shell->history;
## `$shell->script`
Returns the shell history as a Perl program. The
lines are returned as a list. The lines do not have
a one-by-one correspondence to the lines in the history.
print join "\n", $shell->script;
## `$shell->status`
`status` is called for status updates.
## `$shell->display FILENAME LINES`
`display` is called to output listings, currently from the
`history` and `script` commands. If the second parameter
is defined, it is the name of the file to be written,
otherwise the lines are displayed to the user.
# COMMANDS
The shell implements various commands :
## exit
Leaves the shell.
## restart
Restart the shell.
This is mostly useful when you are modifying the shell itself. It dosen't
work if you use the shell in oneliner mode with `-e`.
## get
Download a specific URL.
This is used as the entry point in all sessions
Syntax:
get URL
## save
Download a link into a file.
If more than one link matches the RE, all matching links are
saved. The filename is taken from the last part of the
URL. Alternatively, the number of a link may also be given.
Syntax:
save RE
## content
Display the content for the current page.
Syntax: content \[FILENAME\]
If the FILENAME argument is provided, save the content to the file.
A trailing "\\n" is added to the end of the content when using the
shell, so this might not be ideally suited to save binary files without
manual editing of the produced script.
## title
Display the current page title as found
in the `` tag.
## headers
Prints all `
` through `
` strings found in the content,
indented accordingly. With an argument, prints only those
levels; e.g., `headers 145` prints H1,H4,H5 strings only.
## ua
Get/set the current user agent
Syntax:
# fake Internet Explorer
ua "Mozilla/4.0 (compatible; MSIE 4.01; Windows 98)"
# fake QuickTime v5
ua "QuickTime (qtver=5.0.2;os=Windows NT 5.0Service Pack 2)"
# fake Mozilla/Gecko based
ua "Mozilla/5.001 (windows; U; NT4.0; en-us) Gecko/25250101"
# set empty user agent :
ua ""
## links
Display all links on a page
The links numbers displayed can used by `open` to directly
select a link to follow.
## images
Display images on a page
## parse
Dump the output of HTML::TokeParser of the current content
## forms
Display all forms on the current page.
## form
Select the form named NAME
If NAME matches `/^\d+$/`, it is assumed to be the (1-based) index
of the form to select. There is no way of selecting a numerically
named form by its name.
## dump
Dump the values of the current form
## value
Set a form value
Syntax:
value NAME [VALUE]
## tick
Set checkbox marks
Syntax:
tick NAME VALUE(s)
If no value is given, all boxes are checked.
## untick
Remove checkbox marks
Syntax:
untick NAME VALUE(s)
If no value is given, all marks are removed.
## submit
submits the form without clicking on any button
## click
Clicks on the button named NAME.
No regular expression expansion is done on NAME.
Syntax:
click NAME
If you have a button that has no name (displayed as NONAME),
use
click ""
to click on it.
## open
<open> accepts one argument, which can be a regular expression or the number
of a link on the page, starting at zero. These numbers are displayed by the
`links` function. It goes directly to the page if a number is used
or if the RE has one match. Otherwise, a list of links matching
the regular expression is displayed.
The regular expression should start and end with "/".
Syntax:
open [ RE | # ]
## back
Go back one page in the browser page history.
## reload
Repeat the last request, thus reloading the current page.
Note that also POST requests are blindly repeated, as this command
is mostly intended to be used when testing server side code.
## browse
Open the web browser with the current page
Displays the current page in the browser.
## set
Set a shell option
Syntax:
set OPTION [value]
The command lists all valid options. Here is a short overview over
the different options available :
autosync - automatically synchronize the browser window
autorestart - restart the shell when any required module changes
This does not work with C<-e> oneliners.
watchfiles - watch all required modules for changes
cookiefile - the file where to store all cookies
dumprequests - dump all requests to STDOUT
dumpresponses - dump the headers of the responses to STDOUT
verbose - print commands to STDERR as they are run,
when sourcing from a file
## history
Display your current session history as the relevant commands.
Syntax:
history [FILENAME]
Commands that have no influence on the browser state are not added
to the history. If a parameter is given to the `history` command,
the history is saved to that file instead of displayed onscreen.
## script
Display your current session history as a Perl script using WWW::Mechanize.
Syntax:
script [FILENAME]
If a parameter is given to the `script` command, the script is saved to
that file instead of displayed on the console.
This command was formerly known as `history`.
## comment
Adds a comment to the script and the history. The comment
is prepended with a \\n to increase readability.
## fillout
Fill out the current form
Interactively asks the values hat have no preset
value via the autofill command.
## auth
Set basic authentication credentials.
Syntax:
auth user password
If you know the authority and the realm in advance, you can
presupply the credentials, for example at the start of the script :
>auth corion secret
>get http://www.example.com
Retrieving http://www.example.com(200)
http://www.example.com>
## table
Display a table described by the columns COLUMNS.
Syntax:
table COLUMNS
Example:
table Product Price Description
If there is a table on the current page that has in its first row the three
columns `Product`, `Price` and `Description` (not necessarily in that order),
the script will display these columns of the whole table.
The `HTML::TableExtract` module is needed for this feature.
## tables
Display a list of tables.
Syntax:
tables
This command will display the top row for every
table on the current page. This is convenient if you want
to find out what the exact spellings for each column are.
The command does not always work nice, for example if a
site uses tables for layout, it will be harder to guess
what tables are irrelevant and what tables are relevant.
[HTML::TableExtract](https://metacpan.org/pod/HTML%3A%3ATableExtract) is needed for this feature.
## cookies
Set the cookie file name
Syntax:
cookies FILENAME
## autofill
Define an automatic value
Sets a form value to be filled automatically. The NAME parameter is
the WWW::Mechanize::FormFiller::Value subclass you want to use. For
session fields, `Keep` is a good candidate, for interactive stuff,
`Ask` is a value implemented by the shell.
A field name starting and ending with a slash (`/`) is taken to be
a regular expression and will be applied to all fields with their
name matching the expression. A field with a matching name still
takes precedence over the regular expression.
Syntax:
autofill NAME [PARAMETERS]
Examples:
autofill login Fixed corion
autofill password Ask
autofill selection Random red green orange
autofill session Keep
autofill "/date$/" Random::Date string "%m/%d/%Y"
## eval
Evaluate Perl code and print the result
Syntax:
eval CODE
For the generated scripts, anything matching the regular expression
`/\$self->agent\b/` is automatically
replaced by `$agent` in your eval code, to do the Right Thing.
Examples:
# Say hello
eval "Hello World"
# And take a look at the current content type
eval $self->agent->ct
## source
Execute a batch of commands from a file
Syntax:
source FILENAME
## versions
Print the version numbers of important modules
Syntax:
versions
## timeout
Set new timeout value for the agent. Effects all subsequent
requests. VALUE is in seconds.
Syntax:
timeout VALUE
## ct
prints the content type of the most current response.
Syntax:
ct
## referrer
set the value of the Referer: header
Syntax:
referer URL
referrer URL
## referer
Alias for referrer
## response
display the last server response
## `$shell->munge_code( CODE )`
Munges a coderef to become code fit for
output independent of WWW::Mechanize::Shell.
## `shell`
This subroutine is exported by default as a convenience method
so that the following oneliner invocation works:
perl -MWWW::Mechanize::Shell -eshell
You can pass constructor arguments to this
routine as well. Any scripts given in `@ARGV`
will be run. If `@ARGV` is empty,
an interactive loop will be started.
# SAMPLE SESSIONS
## Entering values
# Search for a term on Google
get http://www.google.com
value q "Corions Homepage"
click btnG
script
# (yes, this is a bad example of automating, as Google
# already has a Perl API. But other sites don't)
## Retrieving a table
get http://www.perlmonks.org
open "/Saints in/"
table User Experience Level
script
# now you have a program that gives you a csv file of
# that table.
## Uploading a file
get http://aliens:xxxxx/
value f path/to/file
click "upload"
## Batch download
# download prerelease versions of my modules
get http://www.corion.net/perl-dev
save /.tar.gz$/
# REGULAR EXPRESSION SYNTAX
Some commands take regular expressions as parameters. A regular
expression **must** be a single parameter matching `^/.*/([isxm]+)?$`, so
you have to use quotes around it if the expression contains spaces :
/link_foo/ # will match as (?-xims:link_foo)
"/link foo/" # will match as (?-xims:link foo)
Slashes do not need to be escaped, as the shell knows that a RE starts and
ends with a slash :
/link/foo/ # will match as (?-xims:link/foo)
"/link/ /foo/" # will match as (?-xims:link/\s/foo)
The `/i` modifier works as expected.
If you desire more power over the regular expressions, consider dropping
to Perl or recommend me a good parser module for regular expressions.
# DISPLAYING HTML
WWW::Mechanize::Shell now uses the module HTML::Display
to display the HTML of the current page in your browser.
Have a look at the documentation of HTML::Display how to
make it use your browser of choice in the case it does not
already guess it correctly.
# FILLING FORMS VIA CUSTOM CODE
If you want to stay within the confines of the shell, but still
want to fill out forms using custom Perl code, here is a recipe
how to achieve this :
Code passed to the `eval` command gets evalutated in the WWW::Mechanize::Shell
namespace. You can inject new subroutines there and these get picked
up by the Callback class of WWW::Mechanize::FormFiller :
# Fill in the "date" field with the current date/time as string
eval sub &::custom_today { scalar localtime };
autofill date Callback WWW::Mechanize::Shell::custom_today
fillout
This method can also be used to retrieve data from shell scripts :
# Fill in the "date" field with the current date/time as string
# works only if there is a program "date"
eval sub &::custom_today { chomp `date` };
autofill date Callback WWW::Mechanize::Shell::custom_today
fillout
As the namespace is different between the shell and the generated
script, make sure you always fully qualify your subroutine names,
either in your own namespace or in the main namespace.
# GENERATED SCRIPTS
The `script` command outputs a skeleton script that reproduces
your actions as done in the current session. It pulls in
`WWW::Mechanize::FormFiller`, which is possibly not needed. You
should add some error and connection checking afterwards.
# ADDING FIELDS TO HTML
If you are automating a JavaScript dependent site, you will encounter
JavaScript like this :
HTML::Form will not know about this and will not have provided a
submit button for you (understandably). If you want to create such
a submit button from within your automation script, use the following
code :
$agent->current_form->push_input( submit => { name => "submit", value =>"submit" } );
This also works for other dynamically generated input fields.
To fake an input field from within a shell session, use the `eval` command :
eval $self->agent->current_form->push_input(submit=>{name=>"submit",value=>"submit"});
And yes, the generated script should do the Right Thing for this eval as well.
# LOCAL FILES
If you want to use the shell on a local file without setting up a `http` server
to serve the file, you can use the `file:` URI scheme to load it into the "browser":
get file:local.html
forms
# PROXY SUPPORT
Currently, the proxy support is realized via a call to
the `env_proxy` method of the WWW::Mechanize object, which
loads the proxies from the environment. There is no provision made
to prevent using proxies (yet). The generated scripts also
load their proxies from the environment.
# ONLINE HELP
The online help feature is currently a bit broken in `Term::Shell`,
but a fix is in the works. Until then, you can re-enable the
dynamic online help by patching `Term::Shell` :
Remove the three lines
my $smry = exists $o->{handlers}{$h}{smry}
? $o->summary($h)
: "undocumented";
in `sub run_help` and replace them by
my $smry = $o->summary($h);
The shell works without this patch and the online help is still
available through `perldoc WWW::Mechanize::Shell`
# BUGS
Bug reports are very welcome - please use the RT interface at
https://rt.cpan.org/NoAuth/Bugs.html?Dist=WWW-Mechanize-Shell or send a
descriptive mail to bug-WWW-Mechanize-Shell@rt.cpan.org . Please
try to include as much (relevant) information as possible - a test script
that replicates the undesired behaviour is welcome every time!
- The two parameter version of the `auth` command guesses the realm from
the last received response. Currently a RE is used to extract the realm,
but this fails with some servers resp. in some cases. Use the four
parameter version of `auth`, or if not possible, code the extraction
in Perl, either in the final script or through `eval` commands.
- The shell currently detects when you want to follow a JavaScript link and tells you
that this is not supported. It would be nicer if there was some callback mechanism
to (automatically?) extract URLs from JavaScript-infected links.
# TODO
- Add XPath expressions (by moving `WWW::Mechanize` from HTML::Parser to XML::XMLlib
or maybe easier, by tacking Class::XPath onto an HTML tree)
- Add `head` as a command ?
- Optionally silence the HTML::Parser / HTML::Forms warnings about invalid HTML.
# EXPORT
The routine `shell` is exported into the importing namespace. This
is mainly for convenience so you can use the following commandline
invocation of the shell like with CPAN :
perl -MWWW::Mechanize::Shell -e"shell"
# REPOSITORY
The public repository of this module is
[https://github.com/Corion/WWW-Mechanize-Shell](https://github.com/Corion/WWW-Mechanize-Shell).
# SUPPORT
The public support forum of this module is
[http://perlmonks.org/](http://perlmonks.org/).
# COPYRIGHT AND LICENSE
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
Copyright (C) 2002-2023 Max Maischein
# AUTHOR
Max Maischein,
Please contact me if you find bugs or otherwise improve the module. More tests are also very welcome !
# SEE ALSO
[WWW::Mechanize](https://metacpan.org/pod/WWW%3A%3AMechanize),[WWW::Mechanize::FormFiller](https://metacpan.org/pod/WWW%3A%3AMechanize%3A%3AFormFiller),[WWW::Mechanize::Firefox](https://metacpan.org/pod/WWW%3A%3AMechanize%3A%3AFirefox)
WWW-Mechanize-Shell-0.62/.gitignore 0000644 0001750 0001750 00000000241 14456560526 016441 0 ustar corion corion Makefile
Makefile.old
*.tar.gz
*.bak
*.swp
pm_to_blib
blib/
WWW-Mechanize-Shell-*
WWW-Mechanize-Shell-*/
.lwpcookies
.releaserc
MYMETA.*
*.pl
.prove
.patch
CVS/
WWW-Mechanize-Shell-0.62/META.yml 0000644 0001750 0001750 00000002146 14456560530 015723 0 ustar corion corion ---
abstract: 'An interactive shell for WWW::Mechanize'
author:
- 'Max Maischein '
build_requires:
CGI: '0'
ExtUtils::MakeMaker: '0'
File::Temp: '0'
Test::HTTP::LocalServer: '0.68'
Test::More: '0'
Test::Without::Module: '0'
URI: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 0
generated_by: 'ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: WWW-Mechanize-Shell
no_index:
directory:
- t
- inc
requires:
HTML::Display: '0'
HTML::TokeParser::Simple: '2'
HTTP::Cookies: '0'
Hook::LexWrap: '0.2'
LWP: '5.69'
LWP::UserAgent: '0'
Term::Shell: '0.02'
Test::Harness: '2.3'
URI::URL: '0'
WWW::Mechanize: '1.2'
WWW::Mechanize::FormFiller: '0.05'
WWW::Mechanize::Link: '1.2'
parent: '0'
perl: '5.006'
resources:
license: https://dev.perl.org/licenses/
repository: git://github.com/Corion/WWW-Mechanize-Shell.git
version: '0.62'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
x_static_install: 1
WWW-Mechanize-Shell-0.62/lib/ 0000755 0001750 0001750 00000000000 14456560530 015215 5 ustar corion corion WWW-Mechanize-Shell-0.62/lib/WWW/ 0000755 0001750 0001750 00000000000 14456560530 015701 5 ustar corion corion WWW-Mechanize-Shell-0.62/lib/WWW/Mechanize/ 0000755 0001750 0001750 00000000000 14456560530 017604 5 ustar corion corion WWW-Mechanize-Shell-0.62/lib/WWW/Mechanize/Shell.pm 0000644 0001750 0001750 00000142300 14456560526 021216 0 ustar corion corion package WWW::Mechanize::Shell;
use strict;
use Carp;
use WWW::Mechanize;
use WWW::Mechanize::FormFiller;
use HTTP::Cookies;
use parent qw( Term::Shell );
use Exporter 'import';
use FindBin;
use File::Temp qw(tempfile);
use URI::URL;
use Hook::LexWrap;
use HTML::Display qw();
use HTML::TokeParser::Simple;
use B::Deparse;
our $VERSION = '0.62';
our @EXPORT = qw( &shell );
=head1 NAME
WWW::Mechanize::Shell - An interactive shell for WWW::Mechanize
=head1 SYNOPSIS
From the command line as
perl -MWWW::Mechanize::Shell -eshell
or alternatively as a custom shell program via :
=for example begin
#!/usr/bin/perl -w
use strict;
use WWW::Mechanize::Shell;
my $shell = WWW::Mechanize::Shell->new("shell");
if (@ARGV) {
$shell->source_file( @ARGV );
} else {
$shell->cmdloop;
};
=for example end
=for example_testing
BEGIN {
require WWW::Mechanize::Shell;
$ENV{PERL_RL} = 0;
$ENV{COLUMNS} = '80';
$ENV{LINES} = '24';
};
BEGIN {
no warnings 'once';
no warnings 'redefine';
*WWW::Mechanize::Shell::cmdloop = sub {};
*WWW::Mechanize::Shell::display_user_warning = sub {};
*WWW::Mechanize::Shell::source_file = sub {};
};
isa_ok( $shell, "WWW::Mechanize::Shell" );
=head1 DESCRIPTION
This module implements a www-like shell above WWW::Mechanize
and also has the capability to output crude Perl code that recreates
the recorded session. Its main use is as an interactive starting point
for automating a session through WWW::Mechanize.
The cookie support is there, but no cookies are read from your existing
browser sessions. See L 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',
=over 4
=item B
my $shell = WWW::Mechanize::Shell->new(
agent => WWW::Mechanize::Chrome->new(),
);
Pass in a premade custom user agent. This object must be compatible to
L. Use this feature from the command line as
perl -Ilib -MWWW::Mechanize::Chrome \
-MWWW::Mechanize::Shell \
-e"shell(agent => WWW::Mechanize::Chrome->new())"
=back
=cut
sub init {
my ($self) = @_;
my ($name,%args) = @{$self->{API}{args}};
$self->{agent} = $args{ agent };
if( ! $self->agent ) {
my $class = $args{ agent_class } || 'WWW::Mechanize';
my $args = $args{ agent_args } || [];
$self->{agent} = $class->new( @$args );
};
$self->{formfiller} = WWW::Mechanize::FormFiller->new(default => [ Ask => $self ]);
$self->{history} = [];
$self->{options} = {
autosync => 0,
warnings => (exists $args{warnings} ? $args{warnings} : 1),
autorestart => 0,
watchfiles => (exists $args{watchfiles} ? $args{watchfiles} : 1),
cookiefile => 'cookies.txt',
dumprequests => 0,
dumpresponses => 0,
verbose => 0,
};
# Install the request dumper :
$self->{request_wrapper} = wrap 'LWP::UserAgent::request',
#pre => sub { printf STDERR "Dumping? %s\n",$self->option("dumprequests"); $self->request_dumper($_[1]) if $self->option("dumprequests"); },
pre => sub { $self->request_dumper($_[1]) if $self->option("dumprequests"); },
post => sub {
$self->response_dumper($_[-1]) if $self->option("dumpresponses");
};
$self->{redirect_ok_wrapper} = wrap 'WWW::Mechanize::redirect_ok',
post => sub {
return unless $_[1];
$self->status( "\nRedirecting to ".$_[1]->uri."\n" );
$_[-1]
};
# Load the proxy settings from the environment
$self->agent->env_proxy()
if $self->agent->can('env_proxy');
# Read our .rc file :
# I could use File::Homedir, but the docs claim it dosen't work on Win32. Maybe
# I should just release a patch for File::Homedir then... Not now.
my $sourcefile;
if (exists $args{rcfile}) {
$sourcefile = delete $args{rcfile};
} else {
my $userhome = $^O =~ /win32/i ? $ENV{'USERPROFILE'} || $ENV{'HOME'} : ((getpwuid($<))[7]);
$sourcefile = "$userhome/.mechanizerc"
if -f "$userhome/.mechanizerc";
};
$self->option('cookiefile', $args{cookiefile}) if (exists $args{cookiefile});
$self->source_file($sourcefile) if defined $sourcefile;
$self->{browser} = undef;
# Keep track of the files we consist of, to enable automatic reloading
$self->{files} = undef;
if ($self->option('watchfiles')) {
eval {
my @files = grep { -f && -r && $_ ne '-e' } values %INC;
local $, = ",";
require File::Modified;
$self->{files} = File::Modified->new(files=>[@files]);
};
$self->display_user_warning( "Module File::Modified not found. Automatic reloading disabled.\n" )
if ($@);
};
};
=head2 C<$shell-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->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-2023 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.62/META.json 0000644 0001750 0001750 00000003723 14456560530 016075 0 ustar corion corion {
"abstract" : "An interactive shell for WWW::Mechanize",
"author" : [
"Max Maischein "
],
"dynamic_config" : 0,
"generated_by" : "ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : 2
},
"name" : "WWW-Mechanize-Shell",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"HTML::Display" : "0",
"HTML::TokeParser::Simple" : "2",
"HTTP::Cookies" : "0",
"Hook::LexWrap" : "0.2",
"LWP" : "5.69",
"LWP::UserAgent" : "0",
"Term::Shell" : "0.02",
"Test::Harness" : "2.3",
"URI::URL" : "0",
"WWW::Mechanize" : "1.2",
"WWW::Mechanize::FormFiller" : "0.05",
"WWW::Mechanize::Link" : "1.2",
"parent" : "0",
"perl" : "5.006"
}
},
"test" : {
"requires" : {
"CGI" : "0",
"File::Temp" : "0",
"Test::HTTP::LocalServer" : "0.68",
"Test::More" : "0",
"Test::Without::Module" : "0",
"URI" : "0"
}
}
},
"release_status" : "stable",
"resources" : {
"license" : [
"https://dev.perl.org/licenses/"
],
"repository" : {
"type" : "git",
"url" : "git://github.com/Corion/WWW-Mechanize-Shell.git",
"web" : "https://github.com/Corion/WWW-Mechanize-Shell"
}
},
"version" : "0.62",
"x_serialization_backend" : "JSON::PP version 4.11",
"x_static_install" : 1
}
WWW-Mechanize-Shell-0.62/xt/ 0000755 0001750 0001750 00000000000 14456560530 015102 5 ustar corion corion WWW-Mechanize-Shell-0.62/xt/99-todo.t 0000644 0001750 0001750 00000002166 14456560526 016505 0 ustar corion corion use Test::More;
use File::Spec;
use File::Find;
use strict;
# Check that all files do not contain any
# lines with "XXX" - such markers should
# either have been converted into Todo-stuff
# or have been resolved.
# The test was provided by Andy Lester.
require './Makefile.PL';
# Loaded from Makefile.PL
our %module = get_module_info();
my @files;
my $blib = File::Spec->catfile(qw(blib lib));
find(\&wanted, grep { -d } ($blib));
if( my $exe = $module{EXE_FILES}) {
push @files, @$exe;
};
plan tests => 2* @files;
foreach my $file (@files) {
source_file_ok($file);
}
sub wanted {
push @files, $File::Find::name if /\.p(l|m|od)$/;
}
sub source_file_ok {
my $file = shift;
open( my $fh, '<', $file ) or die "Can't open $file: $!";
my @lines = <$fh>;
close $fh;
my $n = 0;
for ( @lines ) {
++$n;
s/^/$file ($n): /;
}
my @x = grep /XXX/, @lines;
if ( !is( scalar @x, 0, "Looking for XXXes in $file" ) ) {
diag( $_ ) for @x;
}
@x = grep /<<<|>>>/, @lines;
if ( !is( scalar @x, 0, "Looking for <<<<|>>>> in $file" ) ) {
diag( $_ ) for @x;
}
}
WWW-Mechanize-Shell-0.62/xt/99-changes.t 0000644 0001750 0001750 00000001337 14456560526 017147 0 ustar corion corion #!perl -w
use warnings;
use strict;
use File::Find;
use Test::More tests => 2;
=head1 PURPOSE
This test ensures that the Changes file
mentions the current version and that a
release date is mentioned as well
=cut
require './Makefile.PL';
# Loaded from Makefile.PL
our %module = get_module_info();
my $module = $module{NAME};
(my $file = $module) =~ s!::!/!g;
require "$file.pm";
my $version = sprintf '%0.2f', $module->VERSION;
my $changes = do { local $/; open my $fh, 'Changes' or die $!; <$fh> };
ok $changes =~ /^(.*$version.*)$/m, "We find version $version for $module";
my $changes_line = $1;
ok $changes_line =~ /$version\s+20\d\d-[01]\d-[0123]\d\b/, "We find a release date on the same line"
or diag $changes_line;
WWW-Mechanize-Shell-0.62/xt/99-manifest.t 0000644 0001750 0001750 00000002044 14456560526 017341 0 ustar corion corion use strict;
use Test::More;
# Check that MANIFEST and MANIFEST.skip are sane :
use File::Find;
use File::Spec;
my @files = qw( MANIFEST MANIFEST.SKIP );
plan tests => scalar @files * 4
+1 # MANIFEST existence check
+1 # MYMETA.* non-existence check
;
for my $file (@files) {
ok(-f $file, "$file exists");
open my $fh, '<', $file
or die "Couldn't open $file : $!";
my @lines = <$fh>;
is_deeply([grep(/^$/, @lines)],[], "No empty lines in $file");
is_deeply([grep(/^\s+$/, @lines)],[], "No whitespace-only lines in $file");
is_deeply([grep(/^\s*\S\s+$/, @lines)],[],"No trailing whitespace on lines in $file");
if ($file eq 'MANIFEST') {
chomp @lines;
is_deeply([grep { s/\s.*//; ! -f } @lines], [], "All files in $file exist")
or do { diag "$_ is mentioned in $file but doesn't exist on disk" for grep { ! -f } @lines };
# Exclude some files from shipping
is_deeply([grep(/^MYMETA\.(yml|json)$/, @lines)],[],"We don't try to ship MYMETA.* $file");
};
close $fh;
};
WWW-Mechanize-Shell-0.62/xt/99-unix-text.t 0000644 0001750 0001750 00000001745 14456560526 017507 0 ustar corion corion use Test::More;
# Check that all released module files are in
# UNIX text format
use File::Spec;
use File::Find;
use strict;
my @files = ('Makefile.PL', 'MANIFEST', 'MANIFEST.SKIP', glob 't/*.t');
require './Makefile.PL';
# Loaded from Makefile.PL
our %module = get_module_info();
my @files;
my $blib = File::Spec->catfile(qw(blib lib));
find(\&wanted, grep { -d } ($blib));
if( my $exe = $module{EXE_FILES}) {
push @files, @$exe;
};
plan tests => scalar @files;
foreach my $file (@files) {
unix_file_ok($file);
}
sub wanted {
push @files, $File::Find::name if /\.p(l|m|od)$/;
}
sub unix_file_ok {
my ($filename) = @_;
local $/;
open my $fh, '<', $filename
or die "Couldn't open '$filename' : $!\n";
binmode $fh;
my $content = <$fh>;
my $i;
my @lines = grep { /\x0D\x0A$/sm } map { sprintf "%s: %s\x0A", $i++, $_ } split /\x0A/, $content;
unless (is(scalar @lines, 0,"'$filename' contains no windows newlines")) {
diag $_ for @lines;
};
close $fh;
};
WWW-Mechanize-Shell-0.62/xt/99-test-prerequisites.t 0000644 0001750 0001750 00000006600 14456560526 021416 0 ustar corion corion #!perl -w
use warnings;
use strict;
use Test::More;
use Data::Dumper;
use File::Find;
=head1 DESCRIPTION
This test checks whether all tests still pass when the optional test
prerequisites for the test are not present.
This is done by using L to rerun the test while excluding
the optional prerequisite.
=cut
BEGIN {
eval {
require CPAN::Meta::Prereqs;
require Parse::CPAN::Meta;
require Perl::PrereqScanner::Lite;
require Module::CoreList;
require Test::Without::Module;
require Capture::Tiny;
Capture::Tiny->import('capture');
require Path::Class;
Path::Class->import('dir');
};
if (my $err = $@) {
warn "# $err";
plan skip_all => "Prerequisite needed for testing is missing";
exit 0;
};
};
my @tests;
if( @ARGV ) {
@tests = @ARGV;
} else {
open my $manifest, '<', 'MANIFEST'
or die "Couldn't read MANIFEST: $!";
@tests = grep { -f $_ } grep { m!^(t/.*\.t|scripts/.*\.pl)$! } map { s!\s*$!!; $_ } <$manifest>
}
plan tests => 0+@tests;
my $meta = Parse::CPAN::Meta->load_file('META.json');
# Find what META.* declares
my $explicit_test_prereqs = CPAN::Meta::Prereqs->new( $meta->{prereqs} )->merged_requirements->as_string_hash;
my $minimum_perl = $meta->{prereqs}->{runtime}->{requires}->{perl} || 5.006;
sub distributed_packages {
my @modules;
for( @_ ) {
dir($_)->recurse( callback => sub {
my( $child ) = @_;
if( !$child->is_dir and $child =~ /\.pm$/) {
push @modules, ((scalar $child->slurp()) =~ m/^\s*package\s+(?:#.*?\n\s+)*(\w+(?:::\w+)*)\b/msg);
}
});
};
map { $_ => $_ } @modules;
}
# Find what we distribute:
my %distribution = distributed_packages('blib','t');
my $scanner = Perl::PrereqScanner::Lite->new;
for my $test_file (@tests) {
my $implicit_test_prereqs = $scanner->scan_file($test_file)->as_string_hash;
my %missing = %{ $implicit_test_prereqs };
#warn Dumper \%missing;
for my $p ( keys %missing ) {
# remove core modules
if( Module::CoreList::is_core( $p, undef, $minimum_perl)) {
delete $missing{ $p };
#diag "$p is core for $minimum_perl";
} else {
#diag "$p is not in core for $minimum_perl";
};
# remove explicit (test) prerequisites
for my $k (keys %$explicit_test_prereqs) {
delete $missing{ $k };
};
#warn Dumper $explicit_test_prereqs->as_string_hash;
# Remove stuff from our distribution
for my $k (keys %distribution) {
delete $missing{ $k };
};
}
# If we have no apparent missing prerequisites, we're good
my @missing = sort keys %missing;
# Rerun the test without these modules and see whether it crashes
my @failed;
for my $candidate (@missing) {
diag "Checking that $candidate is not essential";
my @cmd = ($^X, "-MTest::Without::Module=$candidate", "-Mblib", '-w', $test_file);
my $cmd = join " ", @cmd;
my ($stdout, $stderr, $exit) = capture {
system( @cmd );
};
if( $exit != 0 ) {
push @failed, [ $candidate, [@cmd]];
} elsif( $? != 0 ) {
push @failed, [ $candidate, [@cmd]];
};
};
is 0+@failed, 0, $test_file
or diag Dumper \@failed;
};
done_testing;
WWW-Mechanize-Shell-0.62/xt/99-pod.t 0000644 0001750 0001750 00000001455 14456560526 016322 0 ustar corion corion use Test::More;
# Check our Pod
# The test was provided by Andy Lester,
# who stole it from Brian D. Foy
# Thanks to both !
use File::Spec;
use File::Find;
use strict;
eval {
require Test::Pod;
Test::Pod->import;
};
require './Makefile.PL';
# Loaded from Makefile.PL
our %module = get_module_info();
my @files;
if ($@) {
plan skip_all => "Test::Pod required for testing POD";
}
elsif ($Test::Pod::VERSION < 0.95) {
plan skip_all => "Test::Pod 0.95 required for testing POD";
}
else {
my $blib = File::Spec->catfile(qw(blib lib));
find(\&wanted, grep { -d } ($blib));
if( my $exe = $module{EXE_FILES}) {
push @files, @$exe;
};
plan tests => scalar @files;
foreach my $file (@files) {
pod_file_ok($file);
}
}
sub wanted {
push @files, $File::Find::name if /\.p(l|m|od)$/;
}
WWW-Mechanize-Shell-0.62/xt/copyright.t 0000644 0001750 0001750 00000004650 14456560526 017311 0 ustar corion corion #!perl
use warnings;
use strict;
use File::Find;
use Test::More tests => 1;
use POSIX 'strftime';
my $this_year = strftime '%Y', localtime;
my $last_modified_year = 0;
my $is_checkout = -d '.git';
require './Makefile.PL';
# Loaded from Makefile.PL
our %module = get_module_info();
my @files;
#my $blib = File::Spec->catfile(qw(blib lib));
find(\&wanted, grep { -d } ('lib'));
if( my $exe = $module{EXE_FILES}) {
push @files, @$exe;
};
sub wanted {
push @files, $File::Find::name if /\.p(l|m|od)$/;
}
sub collect {
my( $file ) = @_;
note $file;
my $modified_ts;
if( $is_checkout ) {
# diag `git log -1 --pretty="format:%ct" "$file"`;
$modified_ts = `git log -1 --pretty="format:%ct" "$file"`;
} else {
$modified_ts = (stat($_))[9];
}
my $modified_year;
if( $modified_ts ) {
$modified_year = strftime('%Y', localtime($modified_ts));
} else {
$modified_year = 1970;
};
open my $fh, '<', $file
or die "Couldn't read $file: $!";
my @copyright = map {
/\bcopyright\b.*?\d{4}-(\d{4})\b/i
? [ $_ => $1 ]
: ()
}
<$fh>;
my $copyright = 0;
for (@copyright) {
$copyright = $_->[1] > $copyright ? $_->[1] : $copyright;
};
return {
file => $file,
copyright_lines => \@copyright,
copyright => $copyright,
modified => $modified_year,
};
};
my @results;
for my $file (@files) {
push @results, collect($file);
};
for my $file (@results) {
$last_modified_year = $last_modified_year < $file->{modified}
? $file->{modified}
: $last_modified_year;
};
note "Distribution was last modified in $last_modified_year";
my @out_of_date = grep { $_->{copyright} and $_->{copyright} < $last_modified_year } @results;
if(! is 0+@out_of_date, 0, "All files have a current copyright year ($last_modified_year)") {
for my $file (@out_of_date) {
diag sprintf "%s modified %d, but copyright is %d", $file->{file}, $file->{modified}, $file->{copyright};
diag $_ for map {@$_} @{ $file->{copyright_lines}};
};
diag q{To fix (in a rough way, please review) run};
diag sprintf q{ perl -i -ple 's!(\bcopyright\b.*?\d{4}-)(\d{4})\b!${1}%s!i' %s},
$this_year,
join ' ',
map { $_->{file} } @out_of_date;
};
WWW-Mechanize-Shell-0.62/xt/99-compile.t 0000644 0001750 0001750 00000002025 14456560526 017162 0 ustar corion corion #!perl
use warnings;
use strict;
use File::Find;
use Test::More;
BEGIN {
eval 'use Capture::Tiny ":all"; 1';
if ($@) {
plan skip_all => "Capture::Tiny needed for testing";
exit 0;
};
};
plan 'no_plan';
require './Makefile.PL';
# Loaded from Makefile.PL
our %module = get_module_info();
my $last_version = undef;
sub check {
#return if (! m{(\.pm|\.pl) \z}xmsi);
my ($stdout, $stderr, $exit) = capture(sub {
system( $^X, '-Mblib', '-c', $_ );
});
s!\s*\z!!
for ($stdout, $stderr);
if( $exit ) {
diag $stderr;
diag "Exit code: ", $exit;
fail($_);
} elsif( $stderr ne "$_ syntax OK") {
diag $stderr;
fail($_);
} else {
pass($_);
};
}
my @files;
find({wanted => \&wanted, no_chdir => 1},
grep { -d $_ }
'blib/lib', 'examples', 'lib'
);
if( my $exe = $module{EXE_FILES}) {
push @files, @$exe;
};
for (@files) {
check($_)
}
sub wanted {
push @files, $File::Find::name if /\.p(l|m|od)$/;
}
WWW-Mechanize-Shell-0.62/xt/99-synopsis.t 0000644 0001750 0001750 00000003011 14456560526 017415 0 ustar corion corion use strict;
use Test::More;
use File::Spec;
use File::Find;
use File::Temp 'tempfile';
require './Makefile.PL';
# Loaded from Makefile.PL
our %module = get_module_info();
my @files;
my $blib = File::Spec->catfile(qw(blib lib));
find(\&wanted, grep { -d } ($blib));
#if( my $exe = $module{EXE_FILES}) {
# push @files, @$exe;
#};
plan tests => scalar @files;
foreach my $file (@files) {
synopsis_file_ok($file);
}
sub wanted {
push @files, $File::Find::name if /\.p(l|m|od)$/
and $_ !~ /\bDSL\.pm$/; # we skip that one as it initializes immediately
}
sub synopsis_file_ok {
my( $file ) = @_;
my $name = "SYNOPSIS in $file compiles";
open my $fh, '<', $file
or die "Couldn't read '$file': $!";
my @synopsis = map { s!^\s\s!!; $_ } # outdent all code for here-docs
grep { /^\s\s/ } # extract all verbatim (=code) stuff
grep { /^=head1\s+SYNOPSIS$/.../^=/ } # extract Pod synopsis
<$fh>;
if( @synopsis ) {
my($tmpfh,$tempname) = tempfile();
print {$tmpfh} join '', @synopsis;
close $tmpfh; # flush it
my $output = `$^X -Ilib -c $tempname 2>&1`;
if( $output =~ /\ssyntax OK$/ ) {
pass $name;
} else {
fail $name;
diag $output;
diag $_ for @synopsis;
};
unlink $tempname
or warn "Couldn't clean up $tempname: $!";
} else {
SKIP: {
skip "$file has no SYNOPSIS section", 1;
};
};
}
WWW-Mechanize-Shell-0.62/xt/99-versions.t 0000644 0001750 0001750 00000002712 14456560526 017405 0 ustar corion corion #!perl -w
# Stolen from ChrisDolan on use.perl.org
# http://use.perl.org/comments.pl?sid=29264&cid=44309
use warnings;
use strict;
use File::Find;
use Test::More;
require './Makefile.PL';
# Loaded from Makefile.PL
our %module = get_module_info();
my @files;
my $blib = File::Spec->catfile(qw(blib lib));
find(\&wanted, grep { -d } ($blib));
if( my $exe = $module{EXE_FILES}) {
push @files, @$exe;
};
sub read_file {
open my $fh, '<', $_[0]
or die "Couldn't read '$_[0]': $!";
binmode $fh;
local $/;
<$fh>
}
sub wanted {
push @files, $File::Find::name if /\.p(l|m|od)$/;
}
plan tests => 0+@files;
my $last_version = undef;
sub check {
my $content = read_file($_);
# only look at perl scripts, not sh scripts
return if (m{blib/script/}xms && $content !~ m/\A \#![^\r\n]+?perl/xms);
my @version_lines = $content =~ m/ ( [^\n]* \$VERSION \s* = [^=] [^\n]* ) /gxms;
if (@version_lines == 0) {
fail($_);
}
for my $line (@version_lines) {
$line =~ s/^\s+//;
$line =~ s/\s+$//;
if (!defined $last_version) {
$last_version = shift @version_lines;
diag "Checking for $last_version";
pass($_);
} else {
is($line, $last_version, $_);
}
}
}
for (@files) {
check();
};
if (! defined $last_version) {
fail('Failed to find any files with $VERSION');
}
WWW-Mechanize-Shell-0.62/xt/99-minimumversion.t 0000644 0001750 0001750 00000000471 14456560526 020616 0 ustar corion corion #!perl -w
use strict;
use Test::More;
eval {
#require Test::MinimumVersion::Fast;
require Test::MinimumVersion;
Test::MinimumVersion->import;
};
my @files;
if ($@) {
plan skip_all => "Test::MinimumVersion required for testing minimum Perl version";
}
else {
all_minimum_version_from_metajson_ok();
}
WWW-Mechanize-Shell-0.62/xt/meta-lint.t 0000644 0001750 0001750 00000002120 14456560526 017161 0 ustar corion corion #!perl -w
# Stolen from ChrisDolan on use.perl.org
# http://use.perl.org/comments.pl?sid=29264&cid=44309
use warnings;
use strict;
use File::Find;
use Test::More;
eval {
#require Test::MinimumVersion::Fast;
require Parse::CPAN::Meta;
require CPAN::Meta::Validator;
CPAN::Meta::Validator->VERSION(2.15);
};
if ($@) {
plan skip_all => "CPAN::Meta::Validator version 2.15 required for testing META files";
}
else {
plan tests => 4;
}
use lib '.';
our %module;
require 'Makefile.PL';
# Loaded from Makefile.PL
%module = get_module_info();
my $module = $module{NAME};
(my $file = $module) =~ s!::!/!g;
require "$file.pm";
my $version = sprintf '%0.2f', $module->VERSION;
for my $meta_file ('META.yml', 'META.json') {
my $meta = Parse::CPAN::Meta->load_file($meta_file);
my $cmv = CPAN::Meta::Validator->new( $meta );
if(! ok $cmv->is_valid, "$meta_file is valid" ) {
diag $_ for $cmv->errors;
};
# Also check that the declared version matches the version in META.*
is $meta->{version}, $version, "$meta_file version matches module version ($version)";
};
WWW-Mechanize-Shell-0.62/Changes 0000644 0001750 0001750 00000043324 14456560526 015755 0 ustar corion corion Revision history for Perl extension WWW::Mechanize::Shell.
Todo:
* Think about HTML::FillInForm for displaying changed form values interactively
* Check how the new WWW::Mechanize JavaScript handling interacts with the
shells own JS blocking (badly, I guess)
* Use Scalar::Util::weaken if available
* Think how to add other (Xpath) extractions to conveniently
display stuff via CSS selectors or XPath selectors. Steal
from Web::Scraper.
* There is a memory leak between ::FormFiller and ::Shell
* Ditch Hook::LexWrap now that LWP::UserAgent has progress callbacks
* Add set-cookie and delete-cookie commands
* Add (optional) HTTP::Cookies::Find support
0.62 2023-07-21
* Test stability fix
0.61 2023-07-21
* Various test suite updates, no code updates, no need to upgrade
* Test suite now runs in parallel
0.60 2021-12-06
* Delete proxy-related environment variables when testing
Upstreamed from Debian by gregor hermann, thanks!
0.59 2020-05-04
* HTML::Form::find_input() has a 1-based index
Reported by the CPAN testers, thanks!
0.58 2019-09-30
* Made the tests pass on IPv6 enabled systems
Uncovered by making Test::HTTP::LocalServer work on IPv6 enabled systems.
* Test-only improvements, no need to upgrade
0.57 2018-06-04
* Add "images" command to list all images
* Allow other user agent objects like WWW::Mechanize::Chrome
Use it from the command line as
perl -Ilib -MWWW::Mechanize::Chrome \
-MWWW::Mechanize::Shell \
-e"shell(agent => WWW::Mechanize::Chrome->new())"
0.56 2017-04-25
* Send uncompressed output to the browser
(contributed by weltonrodrigo)
* Fix some warnings caused by links without a text
* Fix test suite due to newer version of Test::Without::Module
* Upgrade the test HTTP server to work in absence of CGI.pm
0.55 2015-04-26
* Fix one more test against new sprintf() warnings in 5.21+
0.54 2015-04-26
* Fix test suite against new sprintf() warnings in 5.21+
* Fix test suite against calling CGI::param in list context
Both analyzed and contributed by Slaven Rezic
0.53 2013-08-10
* Add links to repository, contributed by D. Steinbrunner
0.52 2011-01-06
* Fix stupid thinko in test (only affects tests on 5.13+)
0.51 2011-01-05
* Make a test more robust against 5.14
* Streamlined Exporter.pm usage
* Rely on parent.pm instead of base.pm
* No need to upgrade
0.50 2010-08-21
* Remove test file that was just testing LWP functionality and that
failed for some weird setups where nonexistent hosts still
result in a successful HTTP request.
* Added links to repositories
0.49 2010-08-17
* Apply [rt.cpan.org #59246] ,
thanks to Ansgar Burchardt
This fixes another case where API changes in LWP weren't mirrored
by this module.
* Fix t/14-command-identity.t to not make an external request anymore
Addresses [rt.cpan.org #59883]
0.48 2008-11-09
* More test fixes for incompatibilities between LWP and Mechanize 1.34+
* Removed way to set up authentication for more than one site
* WWW::Mechanize monkeypatches LWP::UserAgent and thus you can only ever
have one set of user/password in your script.
0.47 2008-11-02
* Fix tests to work with libwww 5.815+ which automatically retries
with empty user/password
* WWW::Mechanize 1.34+ breaks Basic authentication with LWP 5.815+
so all auth tests are skipped until Andy Lester and Gisle Aas
work out who has to fix their stuff.
* Hook::LexWrap is subject to bug [perl #46217], this might
cause problems if you're running Perl 5.10.0. All tests pass.
0.46 2007-10-03
* Bump version because of borked CPAN upload, retrying
* No need to upgrade
0.45 2007-10-03
* No library code changes, no need to upgrade
* Removed HTML::Display from the distribution
as that now lives its own life on CPAN
* Fix failing tests if HTTP_PROXY was set. This fixes
Debian bug #444634, http://bugs.debian.org/444634
and CPAN RT #29455, thanks to Niko Tyni
0.44 2007-07-07
* Added C and C 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
* Upgrade to Term::Shell v0.02 which now displays the help
summary better.
0.43 2007-05-11
* fix failures on 5.6.2 with a B::Deparse version that doesn't
support ->ambient_pragmas() - they get ignored there now.
0.42 200704..
* Test fixes only, no need to upgrade
* Patches submitted by MAREKR (RT #26397) and somebody else whose
name I cannot find, sorry.
* Delete some more proxy settings for the test runs
0.41 2007-04-14
* Codeacrobat release
* Restore compatibility with WWW::Mechanize 1.22
Thanks to Jörg Meltzer who sent in the patch
0.40 2007-01-17
* Fixed showstopper bug in prompt method that was hidden
by all tests disabling interactive prompts
Thanks to all reporters
0.39
* Bumped module version
* Fix for RT 22121 - shell does not start
0.38 2006-12-14
* Bumped module version
* Added a test for HTML::TableExtract functionality
which went untested so far
* Fixed HTML::TableExtract functionality
This functionality now requires
HTML::TableExtract 2.0 or higher, sorry
* This release now needs WWW::Mechanize 1.20, for the update_html
method which is used in the tests. Sorry.
* Reworked code generation and code execution
* ! Think about plugins for other extractions:
* Template::Extract
* XML::XPath extractions
* Think about using a different shell framework provider
0.37
* Fixed bug that created invalid code for the C command
0.36
* Fixed the actual bug too.
0.35
* Fixed documentation in HTML::Display::Debian about C.
0.34
* Fixed a bug where C