← Back to branch summary

~ubuntu-branches/ubuntu/warty/libwww-perl/warty

« back to all changes in this revision

Viewing changes to bin/lwp-request

  • Committer: Bazaar Package Importer
  • Author(s): Michael Alan Dorman
  • Date: 2004-06-18 16:11:57 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20040618161157-6t4bfw7luro4fi9v
Tags: 5.800-1
http://bugs.debian.org/254742
http://bugs.debian.org/252638
* New upstream version. (closes: bug#254742)
* Fix problem of dangling symlinks---was really a result of the
  Makefile.PL changing up on us (closes: bug#252638)

Show diffs side-by-side

added added

removed removed

Lines of Context:
bin/lwp-request
1
1
#!/usr/bin/perl -w
2
2
 
3
 
# $Id: lwp-request,v 2.1 2002/01/03 02:07:02 gisle Exp $
 
3
# $Id: lwp-request,v 2.6 2003/10/26 14:39:18 gisle Exp $
4
4
#
5
5
# Simple user agent using LWP library.
6
6
 
7
7
=head1 NAME
8
8
 
9
 
lwp-request, GET, HEAD, POST - Simple WWW user agent
 
9
lwp-request - Simple command line user agent
10
10
 
11
11
=head1 SYNOPSIS
12
12
 
51
51
 
52
52
=item -i <time>
53
53
 
54
 
Set the If-Modified-Since header in the request. If I<time> it the
 
54
Set the If-Modified-Since header in the request. If I<time> is the
55
55
name of a file, use the modification timestamp for this file. If
56
56
I<time> is not a file, it is parsed as a literal date. Take a look at
57
 
L<HTTP::Date> for recogniced formats.
 
57
L<HTTP::Date> for recognized formats.
58
58
 
59
59
=item -c <content-type>
60
60
 
107
107
 
108
108
=item -S
109
109
 
110
 
Print response status chain. This shows redirect and autorization
 
110
Print response status chain. This shows redirect and authorization
111
111
requests that are handled by the library.
112
112
 
113
113
=item -e
149
149
 
150
150
=item -a
151
151
 
152
 
Set text(ascii) mode for content input and output.  If this option is not 
 
152
Set text(ascii) mode for content input and output.  If this option is not
153
153
used, content input and output is done in binary mode.
154
154
 
155
155
=back
178
178
$progname =~ s,.*[\\/],,;  # use basename only
179
179
$progname =~ s/\.\w*$//;   # strip extension, if any
180
180
 
181
 
$VERSION = sprintf("%d.%02d", q$Revision: 2.1 $ =~ /(\d+)\.(\d+)/);
 
181
$VERSION = sprintf("%d.%02d", q$Revision: 2.6 $ =~ /(\d+)\.(\d+)/);
182
182
 
183
183
 
184
184
require LWP;
227
227
        my($self, $realm, $uri) = @_;
228
228
        if ($main::options{'C'}) {
229
229
            return split(':', $main::options{'C'}, 2);
230
 
        } elsif (-t) {
 
230
        }
 
231
        elsif (-t) {
231
232
            my $netloc = $uri->host_port;
232
233
            print "Enter username for $realm at $netloc: ";
233
234
            my $user = <STDIN>;
240
241
            print "\n";  # because we disabled echo
241
242
            chomp($password);
242
243
            return ($user, $password);
243
 
        } else {
 
244
        }
 
245
        else {
244
246
            return (undef, undef)
245
247
        }
246
248
    }
311
313
if ($options{'f'}) {
312
314
    if ($options{'c'}) {
313
315
        $allowed_methods{$method} = "C";  # force content
314
 
    } else {
 
316
    }
 
317
    else {
315
318
        $allowed_methods{$method} = "";
316
319
    }
317
 
} elsif (!defined $allowed_methods{$method}) {
 
320
}
 
321
elsif (!defined $allowed_methods{$method}) {
318
322
    die "$progname: $method is not an allowed method\n";
319
323
}
320
324
 
338
342
if (defined $options{'i'}) {
339
343
    if (-e $options{'i'}) {
340
344
        $time = (stat _)[9];
341
 
    } else {
 
345
    }
 
346
    else {
342
347
        $time = str2time($options{'i'});
343
348
        die "$progname: Illegal time syntax for -i option\n"
344
349
            unless defined $time;
354
359
        $options{'c'} = ($method eq "POST") ?
355
360
              "application/x-www-form-urlencoded"
356
361
            : "text/plain";
357
 
    } else {
 
362
    }
 
363
    else {
358
364
        die "$progname: Illegal Content-type format\n"
359
365
            unless $options{'c'} =~ m,^[\w\-]+/[\w\-]+(?:\s*;.*)?$,
360
366
    }
362
368
        if -t;
363
369
    binmode STDIN unless -t or $options{'a'};
364
370
    $content = join("", <STDIN>);
365
 
} else {
 
371
}
 
372
else {
366
373
    die "$progname: Can't set Content-type for $method requests\n"
367
374
        if defined $options{'c'};
368
375
}
391
398
        if ($url =~ /^\w+:/ || $options{'b'}) {  # is there any scheme specification
392
399
            $url = URI->new($url, $options{'b'});
393
400
            $url = $url->abs($options{'b'}) if $options{'b'};
394
 
        } else {
 
401
        }
 
402
        else {
395
403
            $url = uf_uri($url);
396
404
        }
397
405
    };
416
424
 
417
425
    if ($options{'S'}) {
418
426
        printResponseChain($response);
419
 
    } elsif ($options{'s'}) {
 
427
    }
 
428
    elsif ($options{'s'}) {
420
429
        print $response->status_line, "\n";
421
430
    }
422
431
 
426
435
        print "\n";  # separate headers and content
427
436
    }
428
437
 
429
 
    if ($response->is_success) {
430
 
        unless ($options{'d'}) {
431
 
            if ($options{'o'} &&
432
 
                $response->content_type eq 'text/html') {
433
 
                require HTML::Parse;
434
 
                my $html = HTML::Parse::parse_html($response->content);
435
 
                {
436
 
                    $options{'o'} eq 'ps' && do {
437
 
                        require HTML::FormatPS;
438
 
                        my $f = HTML::FormatPS->new;
439
 
                        print $f->format($html);
440
 
                        last;
441
 
                    };
442
 
                    $options{'o'} eq 'text' && do {
443
 
                        require HTML::FormatText;
444
 
                        my $f = HTML::FormatText->new;
445
 
                        print $f->format($html);
446
 
                        last;
447
 
                    };
448
 
                    $options{'o'} eq 'html' && do {
449
 
                        print $html->as_HTML;
450
 
                        last;
451
 
                    };
452
 
                    $options{'o'} eq 'links' && do {
453
 
                        my $base = $response->base;
454
 
                        for ( @{ $html->extract_links } ) {
455
 
                            my($link, $elem) = @$_;
456
 
                            my $tag = uc $elem->tag;
457
 
                            $link = URI->new($link)->abs($base)->as_string;
458
 
                            print "$tag\t$link\n";
459
 
                        }
460
 
                        last;
461
 
                    };
462
 
                    $options{'o'} eq 'dump' && do {
463
 
                        $html->dump;
464
 
                        last;
465
 
                    };
466
 
                    # It is bad to not notice this before now :-(
467
 
                    die "Illegal -o option value ($options{'o'})\n";
468
 
                }
469
 
            } else {
470
 
                binmode STDOUT unless $options{'a'};
471
 
                print $response->content;
 
438
    unless ($options{'d'}) {
 
439
        if ($options{'o'} &&
 
440
            $response->content_type eq 'text/html') {
 
441
            require HTML::Parse;
 
442
            my $html = HTML::Parse::parse_html($response->content);
 
443
            {
 
444
                $options{'o'} eq 'ps' && do {
 
445
                    require HTML::FormatPS;
 
446
                    my $f = HTML::FormatPS->new;
 
447
                    print $f->format($html);
 
448
                    last;
 
449
                };
 
450
                $options{'o'} eq 'text' && do {
 
451
                    require HTML::FormatText;
 
452
                    my $f = HTML::FormatText->new;
 
453
                    print $f->format($html);
 
454
                    last;
 
455
                };
 
456
                $options{'o'} eq 'html' && do {
 
457
                    print $html->as_HTML;
 
458
                    last;
 
459
                };
 
460
                $options{'o'} eq 'links' && do {
 
461
                    my $base = $response->base;
 
462
                    for ( @{ $html->extract_links } ) {
 
463
                        my($link, $elem) = @$_;
 
464
                        my $tag = uc $elem->tag;
 
465
                        $link = URI->new($link)->abs($base)->as_string;
 
466
                        print "$tag\t$link\n";
 
467
                    }
 
468
                    last;
 
469
                };
 
470
                $options{'o'} eq 'dump' && do {
 
471
                    $html->dump;
 
472
                    last;
 
473
                };
 
474
                # It is bad to not notice this before now :-(
 
475
                die "Illegal -o option value ($options{'o'})\n";
472
476
            }
473
477
        }
474
 
    } else {
475
 
        print STDERR $response->error_as_HTML unless $options{'d'};
476
 
        $errors++;
 
478
        else {
 
479
            binmode STDOUT unless $options{'a'};
 
480
            print $response->content;
 
481
        }
477
482
    }
 
483
 
 
484
    $errors++ unless $response->is_success;
478
485
}
479
486
 
480
487
exit $errors;