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

trunk
Last change on this file since b14ab8e was 6eaca65, checked in by mitty <mitty@…>, 12 years ago
  • treat filename with unknown coding set as UTF-8

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

  • Property mode set to 100755
File size: 1.4 KB
RevLine 
[a74d46a]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;
16
17my @URLs;
18if ($target !~ /^http/ && -f $target) {
19    open(my $fh, "<$target");
20    @URLs = <$fh>;
21}
22else {
23    push @URLs, $target;
24}
25
26foreach my $url (@URLs) {
27    chomp $url;
28    my $tmpfile = tmpnam();
29    my $res = $ua->mirror($url, $tmpfile);
30   
31    if ($res->is_success) {
32        my $filename = $res->filename;
33        my $decoder = Encode::Guess->guess($filename);
34        if (ref($decoder)) {
[a1128c4]35            print $decoder->name;
36            $filename = encode(
37                $coding,
38                $decoder->decode($filename),
39                Encode::FB_HTMLCREF
40            );
[a74d46a]41        }
[6eaca65]42        else {
43            print "utf8?";
44            $filename = encode(
45                $coding,
46                decode("utf8", $filename),
47                Encode::FB_HTMLCREF
48            );
49        }
50        print ": $filename\n";
[a74d46a]51       
52        my $suffix = 1;
53        my $savename = $filename;
54        while (-e $savename) {
55            $savename = "$filename.$suffix";
56            $suffix++;
57        }
58        rename($tmpfile, $savename);
59    }
60    else {
61        unlink($tmpfile);
62    }
63}
Note: See TracBrowser for help on using the repository browser.