--- /dev/null
+#!/usr/bin/perl -w
+
+eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
+ if 0; # not running under some shell
+
+=head1 NAME
+
+mech-dump - Dumps information about a web page
+
+=cut
+
+use warnings;
+use strict;
+use WWW::Mechanize;
+use Getopt::Long;
+use Pod::Usage;
+
+my @actions;
+my $absolute;
+
+my $user;
+my $pass;
+my $agent;
+my $agent_alias;
+
+GetOptions(
+ 'user=s' => \$user,
+ 'password=s' => \$pass,
+ forms => sub { push( @actions, \&dump_forms ); },
+ links => sub { push( @actions, \&dump_links ); },
+ images => sub { push( @actions, \&dump_images ); },
+ all => sub { push( @actions, \&dump_forms, \&dump_links, \&dump_images ); },
+ absolute => \$absolute,
+ 'agent=s' => \$agent,
+ 'agent-alias=s' => \$agent_alias,
+ help => sub { pod2usage(1); },
+) or pod2usage(2);
+
+=head1 SYNOPSIS
+
+mech-dump [options] [file|url]
+
+Options:
+
+ --forms Dump table of forms (default action)
+ --links Dump table of links
+ --images Dump table of images
+ --all Dump all three of the above, in that order
+
+ --user=user Set the username
+ --password=pass Set the password
+
+ --agent=agent Specify the UserAgent to pass
+ --agent-alias=alias
+ Specify the alias for the UserAgent to pass.
+ Pick one of:
+ * Windows IE 6
+ * Windows Mozilla
+ * Mac Safari
+ * Mac Mozilla
+ * Linux Mozilla
+ * Linux Konqueror
+
+ --absolute Show URLs as absolute, even if relative in the page
+ --help Show this message
+
+The order of the options specified is relevant. Repeated options
+get repeated dumps.
+
+=cut
+
+my $uri = shift or die "Must specify a URL or file to check. See --help for details.\n";
+if ( -e $uri ) {
+ require URI::file;
+ $uri = URI::file->new_abs( $uri )->as_string;
+}
+
+@actions = (\&dump_forms) unless @actions;
+
+my $mech = WWW::Mechanize->new( cookie_jar => undef );
+if ( defined $agent ) {
+ $mech->agent( $agent );
+}
+elsif ( defined $agent_alias ) {
+ $mech->agent_alias( $agent_alias );
+}
+$mech->env_proxy();
+my $response = $mech->get( $uri );
+if (!$response->is_success and defined ($response->www_authenticate)) {
+ if (!defined $user or !defined $pass) {
+ die("Page requires username and password, but none specified.\n");
+ }
+ $mech->credentials($user,$pass);
+ $response = $mech->get( $uri );
+ $response->is_success or die "Can't fetch $uri with username and password\n", $response->status_line, "\n";
+}
+$mech->is_html or die qq{$uri returns type "}, $mech->ct, qq{", not "text/html"\n};
+
+for my $action ( @actions ) {
+ $action->( $mech );
+}
+
+sub dump_links {
+ my $mech = shift;
+ $mech->dump_links( undef, $absolute );
+ return;
+}
+
+sub dump_images {
+ my $mech = shift;
+ $mech->dump_images( undef, $absolute );
+ return;
+}
+
+sub dump_forms {
+ my $mech = shift;
+ $mech->dump_forms( undef, $absolute );
+ return;
+}
+
+=head1 SEE ALSO
+
+L<WWW::Mechanize>