source: lab.git/misc/save.pl @ a74d46a

trunk
Last change on this file since a74d46a was a74d46a, checked in by mitty <mitty@…>, 11 years ago
  • download files with LWP::UserAgent
  • filename from Content-Disposition and decode with selected coding

git-svn-id: https://lab.mitty.jp/svn/lab/trunk@202 7d2118f6-f56c-43e7-95a2-4bb3031d96e7

  • Property mode set to 100755
File size: 1.1 KB
Line 
1#! /usr/bin/perl -w
2
3use strict;
4use warnings;
5use utf8;
6
7use LWP::UserAgent;
8use Encode;
9use Encode::Guess qw/shift-jis euc-jp 7bit-jis/;
10use File::Temp qw/ :POSIX /;
11
12my $target = shift @ARGV || die "$0: URL or file-of-url-list [coding]\n";
13my $coding = shift @ARGV || 'utf8';
14
15my $ua  = LWP::UserAgent->new;
16my $enc = find_encoding($coding);
17
18my @URLs;
19if ($target !~ /^http/ && -f $target) {
20    open(my $fh, "<$target");
21    @URLs = <$fh>;
22}
23else {
24    push @URLs, $target;
25}
26
27foreach my $url (@URLs) {
28    chomp $url;
29    my $tmpfile = tmpnam();
30    my $res = $ua->mirror($url, $tmpfile);
31   
32    if ($res->is_success) {
33        my $filename = $res->filename;
34        my $decoder = Encode::Guess->guess($filename);
35        if (ref($decoder)) {
36            $filename = $enc->encode($decoder->decode($filename));
37        }
38       
39        my $suffix = 1;
40        my $savename = $filename;
41        while (-e $savename) {
42            $savename = "$filename.$suffix";
43            $suffix++;
44        }
45        rename($tmpfile, $savename);
46    }
47    else {
48        unlink($tmpfile);
49    }
50}
Note: See TracBrowser for help on using the repository browser.