X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FGitalist.git;a=blobdiff_plain;f=local-lib5%2Fbin%2Fmech-dump;fp=local-lib5%2Fbin%2Fmech-dump;h=4be286906594380e8d46ca7f5c2500e2e39fae28;hp=0000000000000000000000000000000000000000;hb=3fea05b9fbf95091f4522528b9980a33e0235603;hpb=af746827daa7a8feccee889e1d12ebc74cc9201e

diff --git a/local-lib5/bin/mech-dump b/local-lib5/bin/mech-dump
new file mode 100755
index 0000000..4be2869
--- /dev/null
+++ b/local-lib5/bin/mech-dump
@@ -0,0 +1,129 @@
+#!/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,
+    headers         => sub { push( @actions, \&dump_headers ); },
+    forms           => sub { push( @actions, \&dump_forms ); },
+    links           => sub { push( @actions, \&dump_links ); },
+    images          => sub { push( @actions, \&dump_images ); },
+    all             => sub { push( @actions, \&dump_headers, \&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:
+
+    --headers       Dump HTTP response headers
+    --forms         Dump table of forms (default action)
+    --links         Dump table of links
+    --images        Dump table of images
+    --all           Dump all four 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};
+
+while ( my $action = shift @actions ) {
+    $action->( $mech );
+    print "\n" if @actions;
+}
+
+
+sub dump_headers {
+    my $mech = shift;
+    $mech->dump_headers( undef );
+    return;
+}
+
+sub dump_forms {
+    my $mech = shift;
+    $mech->dump_forms( undef, $absolute );
+    return;
+}
+
+sub dump_links {
+    my $mech = shift;
+    $mech->dump_links( undef, $absolute );
+    return;
+}
+
+sub dump_images {
+    my $mech = shift;
+    $mech->dump_images( undef, $absolute );
+    return;
+}