WWW::Mechanize::Plugin::Snapshot - Snapshot the Mech object's state
Index
Code Index:
NAME
WWW::Mechanize::Plugin::Snapshot - Snapshot the Mech object's state
VERSION
This document describes WWW::Mechanize::Plugin::Snapshot version 0.01
SYNOPSIS
use WWW::Mechanize::Pluggable;
my $mech->new;
$mech->snapshots_to("/some/file/path");
$mech->get("http://problematic.org");
# Create timestamped snapshot
$snapshot_file_name = $mech->snapshot("Accessing problematic.org");
# Create user-named snapshot
$foo_file = $mech->snapshot("Special file", "foo");
# Preset the comment:
$mech->snapshot_comment("Failed during test set 1");
# Resulting file uses the comment preset before the
# snapshot call.
$standard_name = $mech->snapshot();
# Use a different filename. keeping the preset comment:
$foo_file = $mech->snapshot(undef, "foo");
DESCRIPTION
WWW::Mechanize::Plugin::Snapshot is a Web debugging plugin. It allows
you to selectively dump the results of an HTTP request to files that can
be displayed in a browser, showing not only the web page at the time of
the request, but also
- * The URL of the request.
- * A formatted copy of the HTTP request
- * A formatted HTTP response (less the actual content and the request)
- * The current contents of the cookie jar
- * The actual web page content
The output is displayed in a frame, with the debug information on the left
and the actual page HTML as fetched at the time of the snapshot on the right.
INTERFACE
init
Standard importation of methods into WWW::Mechanize::Pluggable.
snapshots_to($dir)
Requires a directory to which the snapshots will be taken.
To separate different runs, a subdirectory of this directory
will be created, using a human-readable form of the current
time as part of the name.
If this method is not called prior to the use of snapshot,
the system default temporary file directory is used. If no
such directory is defined in the TMP or TMPDIR environment
variables, snapshots_to dies.
snapshot
Takes a snapshot of the current state of the WWW::Mechanize object
contained in the WWW::Mechanize::Pluggable object.
snap_layout
Allows you to choose an alternative layout for the snapshots. Current
options are "horizontal" and "vertical" (the default).
DIAGNOSTICS
No TMPDIR/TEMP defined on this system!-
You called snapshots_to without a temporary directory,
but no system temporary directory name was available to the
program. Either call snapshots_to with a writeable
directory name, or set the TMP or TMPDIR environment
variable to reflect the desired name.
Couldn't create directory %s: %s-
The program couldn't create the directory you
specified. A diagnostic follows the colon to
help you find out why not.
%s is not a directory-
The argument you supplied to snapshots_to
is not a directory.
No HTML output file name supplied-
Internal error: _build_file wasn't given a
file into which output is to be saved. Please
contact the author.
No customization hash supplied-
Internal error: _build_file was not supplied
with the information to fill out the template.
Please contact the author.
Nonexistent template %s-
Internal error: _build_file was supplied
with a bad file template. Please contact the
author.
Can't write to %s file %s: $!-
We attempted to take a snapshot, but we couldn't write the file to
the selected temporary directory. The contents of $! are appended
to try to diagnose the error further.
CONFIGURATION AND ENVIRONMENT
WWW::Mechanize::Plugin::Snapshot requires no configuration files.
It needs the TMP or TMPDIR environment variable to select the
system temporary directory if no argument is supplied to snapshots_to.
DEPENDENCIES
Since this is a WWW::Mechanize::Pluggable plugin, that module is required.
INCOMPATIBILITIES
BUGS AND LIMITATIONS
No bugs have been reported.
Please report any bugs or feature requests to
bug-www-mechanize-plugin-snapshot@rt.cpan.org, or through the web interface at
http://rt.cpan.org.
AUTHOR
Joe McMahon <mcmahon@yahoo-inc.com >
LICENCE AND COPYRIGHT
Copyright (c) 2005, Joe McMahon <mcmahon@yahoo-inc.com >. All rights reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See perlartistic.
DISCLAIMER OF WARRANTY
BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
NECESSARY SERVICING, REPAIR, OR CORRECTION.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
package WWW::Mechanize::Plugin::Snapshot;
our $VERSION = '0.20';
use warnings;
use strict;
use Carp;
use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_accessors(qw(_snap_dir_made _suffix snapshot_comment
snap_prefix _run_tag _snap_count));
use File::Path;
use File::Spec;
use Text::Template;
use Data::Dumper;
my %template = (
horizontal => {
frame =><<EOS,
<html>
<head><title>Page snapshot: [\$formatted_date]</title>
</head>
<frameset rows="36%,64%">
<frame src="debug_[\$suffix]-[\$snap_count].html">
<frame src="content_[\$suffix]-[\$snap_count].[\$content_type]">
</frameset>
</html>
EOS
content=><<EOS,
[\$content]
EOS
debug=><<EOS,
<html>
<head>
<title>Page snapshot: debug info</title>
<STYLE TYPE="text/css">
<!--
H1 { color: black; background: #eeeeee; font-size: 110%; font-family: verdana, helvetica, sans-serif }
pre { font-family: courier font-size:50%}
-->
</STYLE>
</head>
<body>
<h1>Description</h1><div class="comment">[\$comment]</div>
<h1>Original URL</h1><div class="url">[\$url]</div>
<h1>HTTP request</h1><div class="request"><pre>[\$req]</pre></div>
<h1>HTTP response</h1><div class="response"><pre>[\$res]</pre></div>
<h1>Cookie jar</h1><div class="jar"><pre>[\$jar]</pre></div>
</body>
</html>
EOS
},
vertical => {
frame =><<EOS,
<html>
<head><title>Page snapshot: [\$formatted_date]</title>
</head>
<frameset cols="36%,64%">
<frame src="debug_[\$suffix]-[\$snap_count].html">
<frame src="content_[\$suffix]-[\$snap_count].[\$content_type]">
</frameset>
</html>
EOS
content=><<EOS,
[\$content]
EOS
debug=><<EOS,
<html>
<head>
<title>Page snapshot: debug info</title>
<STYLE TYPE="text/css">
<!--
H1 { color: black; background: #eeeeee; font-size: 110%; font-family: verdana, helvetica, sans-serif }
pre { font-family: courier font-size:50%}
-->
</STYLE>
</head>
<body>
<h1>Description</h1><div class="comment">[\$comment]</div>
<h1>Original URL</h1><div class="url">[\$url]</div>
<h1>HTTP request</h1><div class="request"><pre>[\$req]</pre></div>
<h1>HTTP response</h1><div class="response"><pre>[\$res]</pre></div>
<h1>Cookie jar</h1><div class="jar"><pre>[\$jar]</pre></div>
</body>
</html>
EOS
},
popup => {
frame =><<EOS,
<head><title>Page snapshot: </title>
<STYLE TYPE="text/css">
<!--
H1 { color: black; background: #eeeeee; font-size: 110%; font-family: verdana, helvetica, sans-serif }
pre { font-family: courier font-size:50%}
-->
</STYLE>
</head>
<body>
<h1>Pop up original page in <a href="content_[\$suffix]-[\$snap_count].[\$content_type]" target="_blank">another window</a>.</h1>
<iframe width="100%" height="90%" src="debug_[\$suffix]-[\$snap_count].html">
</body>
</html>
EOS
content=><<EOS,
[\$content]
EOS
debug=><<EOS,
<html>
<head>
<title>Page snapshot: debug info</title>
<STYLE TYPE="text/css">
<!--
H1 { color: black; background: #eeeeee; font-size: 110%; font-family: verdana, helvetica, sans-serif }
pre { font-family: courier font-size:50%}
-->
</STYLE>
</head>
<body>
<h1>Description</h1><div class="comment">[\$comment]</div>
<h1>Original URL</h1><div class="url">[\$url]</div>
<h1>HTTP request</h1><div class="request"><pre>[\$req]</pre></div>
<h1>HTTP response</h1><div class="response"><pre>[\$res]</pre></div>
<h1>Cookie jar</h1><div class="jar"><pre>[\$jar]</pre></div>
</body>
</html>
EOS
},
);
sub init {
no strict 'refs';
*{caller() . "::snapshots_to"} = \&snapshots_to;
*{caller() . "::snapshot"} = \&snapshot;
*{caller() . "::_suffix"} = \&_suffix;
*{caller() . "::snapshot_comment"} = \&snapshot_comment;
*{caller() . "::_mk_name"} = \&_mk_name;
*{caller() . "::_mk_short_name"} = \&_mk_short_name;
*{caller() . "::_build_file"} = \&_build_file;
*{caller() . "::_template"} = \&_template;
*{caller() . "::snap_prefix"} = \&snap_prefix;
*{caller() . "::_run_tag"} = \&_run_tag;
*{caller() . "::_snapped"} = \&_snapped;
*{caller() . "::_snap_count"} = \&_snap_count;
*{caller() . "::snap_layout"} = \&snap_layout;
*{caller() . "::_snap_dir_made"} = \&_snap_dir_made;
}
sub _snapped {
my ($pluggable) = @_;
my $current_count = $pluggable->_snap_count() || 0;
$pluggable->_snap_count($current_count+1);
}
sub snapshots_to {
my ($pluggable, $snap_dir) = @_;
my $now = _pretty_time();
$pluggable->_suffix(_pretty_time())
unless $pluggable->_suffix();
$pluggable->_run_tag("run_".$pluggable->_suffix)
unless $pluggable->_run_tag;
$pluggable->_snap_count(0)
unless defined $pluggable->_snap_count();
if (!defined $snap_dir) {
# No argument, grab existing or create from
# defaults if possible
if (!defined $pluggable->{SnapDirectory}) {
$snap_dir =
$ENV{TMPDIR} || $ENV{TEMP}|| $ENV{TMP} ||
die "No TMPDIR/TEMP defined on this system!\n";
$snap_dir =
File::Spec->catfile($snap_dir, $pluggable->_run_tag());
}
else {
# use the existing value
$snap_dir = $pluggable->{SnapDirectory};
}
}
else {
# Arg supplied, add on the timestamp
$snap_dir = File::Spec->catfile($snap_dir, $pluggable->_run_tag());
}
if (-e $snap_dir) {
die "$snap_dir is not a directory\n"
unless -d $snap_dir;
}
$pluggable->{SnapDirectory} = $snap_dir;
return $snap_dir;
}
sub snap_layout {
my ($self, $layout) = @_;
my $current = $self->{SnapshotLayout} || '';
# Set the layout if one was supplied.
if (defined $layout) {
$self->{SnapshotLayout} = $layout;
}
# Set to default if never initialized or
# if the new layout doesn't correspond to reality.
$self->{SnapshotLayout} = 'vertical'
unless defined $self->{SnapshotLayout} and
exists $template{$self->{SnapshotLayout}};
# Blow away cached templates if layout is changed
$self->{SnapTemplates} = {}
if $self->{SnapshotLayout} ne $current;
return $self->{SnapshotLayout};
}
sub snapshot {
my ($pluggable, $comment, $suffix) = @_;
local $_;
my @template_text;
$pluggable->_snapped;
# Determine if content is XML; markup is a little different
# if so.
my $is_xml = ($pluggable->content =~ /^<\?xml/);
# Use passed-in suffix if available, and
# set it as the default suffix. If not,
# continue using the one set up in snapshots_to.
if (defined $suffix) {
$pluggable->_suffix($suffix);
}
else {
$suffix = $pluggable->_suffix();
}
my $snap_dir = $pluggable->{SnapDirectory};
if (!-e $snap_dir) {
eval { mkpath $snap_dir };
if ($@) {
die "Couldn't create directory $snap_dir: $@\n";
}
}
my $frame_file =
$pluggable->_build_file(name=>'frame',
version => $pluggable->_snap_count,
hash=>{suffix => $suffix,
content_type => ($is_xml ? 'xml' : 'html'),
snap_count => $pluggable->_snap_count()},
);
# We need to nuke stuff out of the response, but we don't want to
# damage the original. Clone it, and then discard stuff from the
# clone.
my %res = %{$pluggable->mech->{res}};
delete $res{'_content'};
delete $res{'_request'};
$pluggable->_build_file(name=>'debug',
version => $pluggable->_snap_count,
hash=>{url => $pluggable->base,
comment => ($comment ||
$pluggable->snapshot_comment ||
"No comment specified"),
content => $pluggable->content(base_href=>$pluggable->base),
req => Dumper($pluggable->mech->{req}),
res => Dumper(\%res),
jar => Dumper($pluggable->cookie_jar),
suffix => $suffix,
}
);
$pluggable->_build_file(name=>'content',
content_type=> ($is_xml ? 'xml' : 'html'),
version => $pluggable->_snap_count,
hash=>{content => $pluggable->content,
suffix => $suffix,
},
);
my $prefix = $pluggable->snap_prefix();
if (defined $prefix) {
$frame_file = $prefix . "/" . $pluggable->_run_tag . "/" .
$pluggable->_mk_short_name(name=>"frame",
version=>$pluggable->_snap_count);
}
else {
$frame_file = $pluggable->_mk_name(name=>"frame",
version=>$pluggable->_snap_count);
}
$frame_file =~ s{(?<!http:)//}{/}gsm;
return $frame_file;
}
sub _pretty_time {
my @t = split(/\s+|:/,scalar localtime);
return sprintf("%s-%s-%02d-%02d-%02d-%02d-%04d",@t);
}
sub _build_file {
my ($pluggable, %args) = @_;
die "No HTML output file name supplied"
unless defined $args{name};
die "No customization hash supplied"
unless $args{hash};
my $template;
if (!($template = $pluggable->_template($args{name}))) {
# Done this way so we don't have to rebuild the templates
# every time through.
die "Nonexistent template $args{name}\n"
unless $template{$pluggable->snap_layout()}{$args{name}};
$template = Text::Template->new(TYPE=>'ARRAY',
DELIMITERS=>['[',']'],
SOURCE=>[$template{$pluggable->snap_layout()}{$args{name}}]);
$pluggable->_template($args{name}, $template);
}
my $filename = $pluggable->_mk_name(%args);
my $fh;
open $fh, ">$filename"
or die "Can't write to $args{name} file $filename: $!";
print $fh $template->fill_in(HASH=>$args{hash});
close $fh;
return $filename;
}
sub _mk_name {
my ($pluggable, %args) = @_;
return File::Spec->catfile($pluggable->snapshots_to(),
$pluggable->_mk_short_name(%args));
}
sub _mk_short_name {
my ($pluggable, %args) = @_;
$args{content_type} = 'html' unless defined $args{content_type};
return $args{name} . "_" . $pluggable->_suffix .
($args{version} ? "-$args{version}.$args{content_type}"
: ".$args{content_type}");
}
sub _template {
my ($pluggable, $template_name, $template) = @_;
die "Can't access undefined template!" unless defined $template_name;
if (defined $template_name and defined $template) {
$pluggable->{SnapTemplates}->{$template_name} = $template;
}
return $pluggable->{SnapTemplates}->{$template_name};
}
1; # Magic true value required at end of module
__END__