git.maemo.org Git - dh-make-perl/blob - dev/arm/libwww-mechanize-perl/libwww-mechanize-perl-1.34/debian/libwww-mechanize-perl/usr/bin/mech-dump

   1 #!/usr/bin/perl -w
   2
   3 eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
   4     if 0; # not running under some shell
   5
   6 =head1 NAME
   7
   8 mech-dump - Dumps information about a web page
   9
  10 =cut
  11
  12 use warnings;
  13 use strict;
  14 use WWW::Mechanize;
  15 use Getopt::Long;
  16 use Pod::Usage;
  17
  18 my @actions;
  19 my $absolute;
  20
  21 my $user;
  22 my $pass;
  23 my $agent;
  24 my $agent_alias;
  25
  26 GetOptions(
  27     'user=s'        => \$user,
  28     'password=s'    => \$pass,
  29     forms           => sub { push( @actions, \&dump_forms ); },
  30     links           => sub { push( @actions, \&dump_links ); },
  31     images          => sub { push( @actions, \&dump_images ); },
  32     all             => sub { push( @actions, \&dump_forms, \&dump_links, \&dump_images ); },
  33     absolute        => \$absolute,
  34     'agent=s'       => \$agent,
  35     'agent-alias=s' => \$agent_alias,
  36     help            => sub { pod2usage(1); },
  37 ) or pod2usage(2);
  38
  39 =head1 SYNOPSIS
  40
  41 mech-dump [options] [file|url]
  42
  43 Options:
  44
  45     --forms         Dump table of forms (default action)
  46     --links         Dump table of links
  47     --images        Dump table of images
  48     --all           Dump all three of the above, in that order
  49
  50     --user=user     Set the username
  51     --password=pass Set the password
  52
  53     --agent=agent   Specify the UserAgent to pass
  54     --agent-alias=alias
  55                     Specify the alias for the UserAgent to pass.
  56                     Pick one of:
  57                         * Windows IE 6
  58                         * Windows Mozilla
  59                         * Mac Safari
  60                         * Mac Mozilla
  61                         * Linux Mozilla
  62                         * Linux Konqueror
  63
  64     --absolute      Show URLs as absolute, even if relative in the page
  65     --help          Show this message
  66
  67 The order of the options specified is relevant.  Repeated options
  68 get repeated dumps.
  69
  70 =cut
  71
  72 my $uri = shift or die "Must specify a URL or file to check.  See --help for details.\n";
  73 if ( -e $uri ) {
  74     require URI::file;
  75     $uri = URI::file->new_abs( $uri )->as_string;
  76 }
  77
  78 @actions = (\&dump_forms) unless @actions;
  79
  80 my $mech = WWW::Mechanize->new( cookie_jar => undef );
  81 if ( defined $agent ) {
  82     $mech->agent( $agent );
  83 }
  84 elsif ( defined $agent_alias ) {
  85     $mech->agent_alias( $agent_alias );
  86 }
  87 $mech->env_proxy();
  88 my $response = $mech->get( $uri );
  89 if (!$response->is_success and defined ($response->www_authenticate)) {
  90     if (!defined $user or !defined $pass) {
  91         die("Page requires username and password, but none specified.\n");
  92     }
  93     $mech->credentials($user,$pass);
  94     $response = $mech->get( $uri );
  95     $response->is_success or die "Can't fetch $uri with username and password\n", $response->status_line, "\n";
  96 }
  97 $mech->is_html or die qq{$uri returns type "}, $mech->ct, qq{", not "text/html"\n};
  98
  99 for my $action ( @actions ) {
 100     $action->( $mech );
 101 }
 102
 103 sub dump_links {
 104     my $mech = shift;
 105     $mech->dump_links( undef, $absolute );
 106     return;
 107 }
 108
 109 sub dump_images {
 110     my $mech = shift;
 111     $mech->dump_images( undef, $absolute );
 112     return;
 113 }
 114
 115 sub dump_forms {
 116     my $mech = shift;
 117     $mech->dump_forms( undef, $absolute );
 118     return;
 119 }
 120
 121 =head1 SEE ALSO
 122
 123 L<WWW::Mechanize>