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

trunk
Last change on this file since a1128c4 was a1128c4, checked in by mitty <mitty@…>, 11 years ago
  • convert to FB_HTMLCREF if there are malformed characters

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

  • Property mode set to 100755
File size: 1.2 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;
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)) {
35            print $decoder->name;
36            $filename = encode(
37                $coding,
38                $decoder->decode($filename),
39                Encode::FB_HTMLCREF
40            );
41            print ": $filename\n";
42        }
43       
44        my $suffix = 1;
45        my $savename = $filename;
46        while (-e $savename) {
47            $savename = "$filename.$suffix";
48            $suffix++;
49        }
50        rename($tmpfile, $savename);
51    }
52    else {
53        unlink($tmpfile);
54    }
55}
Note: See TracBrowser for help on using the repository browser.