Add ARM files
[dh-make-perl] / dev / arm / libwww-mechanize-perl / libwww-mechanize-perl-1.34 / debian / libwww-mechanize-perl / usr / bin / mech-dump
diff --git a/dev/arm/libwww-mechanize-perl/libwww-mechanize-perl-1.34/debian/libwww-mechanize-perl/usr/bin/mech-dump b/dev/arm/libwww-mechanize-perl/libwww-mechanize-perl-1.34/debian/libwww-mechanize-perl/usr/bin/mech-dump
new file mode 100755 (executable)
index 0000000..763b332
--- /dev/null
@@ -0,0 +1,123 @@
+#!/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>