r17477 - in /branches/upstream/libhtml-copy-perl/current: Changes META.yml bin/htmlcopy lib/HTML/Copy.pm t/parse.t

gregoa-guest at users.alioth.debian.org gregoa-guest at users.alioth.debian.org
Sat Mar 15 17:36:56 UTC 2008


Author: gregoa-guest
Date: Sat Mar 15 17:36:55 2008
New Revision: 17477

URL: http://svn.debian.org/wsvn/?sc=1&rev=17477
Log:
[svn-upgrade] Integrating new upstream version, libhtml-copy-perl (1.30)

Modified:
    branches/upstream/libhtml-copy-perl/current/Changes
    branches/upstream/libhtml-copy-perl/current/META.yml
    branches/upstream/libhtml-copy-perl/current/bin/htmlcopy
    branches/upstream/libhtml-copy-perl/current/lib/HTML/Copy.pm
    branches/upstream/libhtml-copy-perl/current/t/parse.t

Modified: branches/upstream/libhtml-copy-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libhtml-copy-perl/current/Changes?rev=17477&op=diff
==============================================================================
--- branches/upstream/libhtml-copy-perl/current/Changes (original)
+++ branches/upstream/libhtml-copy-perl/current/Changes Sat Mar 15 17:36:55 2008
@@ -1,4 +1,13 @@
 Revision history for Perl extension HTML::Copy.
+
+1.3 2008-02-20
+    * HTML::Copy can accept file handles instead file pathes.
+    * htmlcopy can use standard input and output.
+    * The working in MS Windows platform is expected again.
+        * Thanks to Taro Nishino.
+    
+1.24 2008-01-24
+    * The test may success in MS Windows platform.
 
 1.23 2008-01-16
     * Add error handling routine when a souce file can't be opened.

Modified: branches/upstream/libhtml-copy-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libhtml-copy-perl/current/META.yml?rev=17477&op=diff
==============================================================================
--- branches/upstream/libhtml-copy-perl/current/META.yml (original)
+++ branches/upstream/libhtml-copy-perl/current/META.yml Sat Mar 15 17:36:55 2008
@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         HTML-Copy
-version:      1.23
+version:      1.3
 version_from: lib/HTML/Copy.pm
 installdirs:  site
 requires:

Modified: branches/upstream/libhtml-copy-perl/current/bin/htmlcopy
URL: http://svn.debian.org/wsvn/branches/upstream/libhtml-copy-perl/current/bin/htmlcopy?rev=17477&op=diff
==============================================================================
--- branches/upstream/libhtml-copy-perl/current/bin/htmlcopy (original)
+++ branches/upstream/libhtml-copy-perl/current/bin/htmlcopy Sat Mar 15 17:36:55 2008
@@ -6,32 +6,43 @@
 use HTML::Copy;
 use Getopt::Long;
 use Pod::Usage;
+use Cwd;
 
-our $VERSION = '1.23';
+our $VERSION = '1.3';
 
 {
-	my $man = 0;
-	my $help = 0;
+    my $man = 0;
+    my $help = 0;
   
-	GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
-	pod2usage(-exitstatus => 0, -verbose => 1) if $help;
-	pod2usage(-exitstatus => 0, -verbose => 2) if $man;
+    GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
+    pod2usage(-exitstatus => 0, -verbose => 1) if $help;
+    pod2usage(-exitstatus => 0, -verbose => 2) if $man;
 
-	if (@ARGV > 2) {
-		pod2usage(-message => 'Too many arguments.', 
-				-exitstatus => 1, -verbose => 1)
+    if (@ARGV > 2) {
+        pod2usage(-message => 'Too many arguments.', 
+                    -exitstatus => 1, -verbose => 1)
   }
 
-	if (@ARGV < 2) {
-		pod2usage(-message => 'Required arguments is not given.', 
-				-exitstatus => 1, -verbose => 1)
-	}
-
-	my ($source_path, $target_path) = @ARGV;
-
-	my $p = HTML::Copy->new($source_path);
-	#$p->set_encode_suspects(qw/euc-jp shiftjis 7bit-jis/);
-	$p->copy_to($target_path);
+    if (@ARGV < 1) {
+        pod2usage(-message => 'Required arguments is not given.', 
+                    -exitstatus => 1, -verbose => 1)
+    }
+    
+    my ($source_path, $target_path) = @ARGV;
+    
+    my $in;
+    if ($source_path eq '-' ) {
+        open $in , " -";
+    } else {
+        $in = $source_path;
+    }
+    
+    my $p = HTML::Copy->new($in);
+    #$p->set_encode_suspects(qw/euc-jp shiftjis 7bit-jis/);
+    unless ($target_path) {
+        open $target_path, ">-";
+    }
+    $p->copy_to($target_path);
 }
 
 1;
@@ -44,12 +55,15 @@
 
 =head1 SYNOPSIS
 
- htmlcopy [OPTION] SOURCE DESTINATION
- htmlcopy [OPTION] SOURCE DIRECTORY
+ htmlcopy [OPTION] {SOURCE | -} [DESTINATION]
 
 =head1 DESCRIPTION
 
-htmlcopy a source HTML file into DESTINATION or DIRECTORY. If the HTML file have links to images, other HTML files, javascripts and cascading style sheets, htmlcopy changing link path in the HTML file to keep the link destination.
+htmlcopy a source HTML file into DESTINATION. If the HTML file have links to images, other HTML files, javascripts and cascading style sheets, htmlcopy changing link path in the HTML file to keep the link destination.
+
+When DESTINATION is omitted, the modified HTML is written in the standard output. Also it is assumed that output location is the current working directory.
+
+SOURCE and DESTINATION should be cleanuped pathes. For example, a verbose path like '/aa/bb/../cc' may cause converting links wrongly. This is a limitaion of the URI module's rel method. To cleanup pathes, Cwd::realpath is useful.
 
 =head1 OPTIONS
 

Modified: branches/upstream/libhtml-copy-perl/current/lib/HTML/Copy.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libhtml-copy-perl/current/lib/HTML/Copy.pm?rev=17477&op=diff
==============================================================================
--- branches/upstream/libhtml-copy-perl/current/lib/HTML/Copy.pm (original)
+++ branches/upstream/libhtml-copy-perl/current/lib/HTML/Copy.pm Sat Mar 15 17:36:55 2008
@@ -6,8 +6,7 @@
 use File::Spec;
 use File::Basename;
 use File::Path;
-use Cwd;
-use IO::File;
+#use Cwd;
 use utf8;
 use Encode;
 use Encode::Guess;
@@ -20,37 +19,48 @@
 
 use base qw(HTML::Parser Class::Accessor);
 
-__PACKAGE__->mk_accessors(qw(source_path
-                            destination_path
-                            link_attributes
-                            has_base
-                            source_uri
-                            destination_uri));
+__PACKAGE__->mk_accessors(qw(link_attributes
+                            has_base));
 
 #use Data::Dumper;
 
+our @default_link_attributes = ('src', 'href', 'background', 'csref', 'livesrc');
+# 'livesrc' and 'csref' are uesed in Adobe GoLive
+
 =head1 NAME
 
 HTML::Copy - copy a HTML file without breaking links.
 
 =head1 VERSION
 
-Version 1.23
-
-=cut
-
-our $VERSION = '1.23';
+Version 1.3
+
+=cut
+
+our $VERSION = '1.3';
 
 =head1 SYMPOSIS
 
   use HTML::Copy;
-  
+
   HTML::Copy->htmlcopy($source_path, $destination_path);
-  
+
   # or
-  
+
   $p = HTML::Copy->new($source_path);
   $p->copy_to($destination_path);
+
+  # or
+
+  open my $in, "<", $source_path;
+  $p = HTML::Copy->new($in)
+  $p->source_path($source_path);    # can be omitted, 
+                                    # when $source_path is in cwd.
+
+  $p->destination_path($destination_path) # can be omitted, 
+                                          # when $source_path is in cwd.
+  open my $out, ">", $source_path;
+  $p->copy_to($out);
 
 =head1 DESCRIPTION
 
@@ -82,16 +92,17 @@
 
 =head2 parse_file
 
-    $html_text = HTML::Copy->parse_file($source_path, $destination_path);
+    $html_text = HTML::Copy->parse_file($source_path, 
+                                        $destination_path);
 
 Parse contents of $source_path and change links to copy into $destination_path. But don't make $destination_path. Just return modified HTML. The encoding of strings is converted into utf8.
 
 =cut
 
 sub parse_file($$$) {
-    my ($class, $source_path, $destination_path) = @_;
-    my $p = $class->new($source_path);
-    return $p->parse_to($destination_path);
+    my ($class, $source, $destination) = @_;
+    my $p = $class->new($source);
+    return $p->parse_to($destination);
 }
 
 
@@ -99,9 +110,11 @@
 
 =head2 new
 
-    $p = HTML::Copy->new($source_path);
-
-Make an instance of this module.
+    $p = HTML::Copy->new($source);
+
+Make an instance of this module with specifing a source of HTML.
+
+The argument $source can be a file path or a file handle. When a file handle is passed, you may need to indicate a file path of the passed file handle by the method L<"source_path">. If calling L<"source_path"> is omitted, it is assumed that the location of the file handle is the current working directory.
 
 =cut
 
@@ -113,16 +126,15 @@
         my @keys = keys %args;
         @$self{@keys} = @args{@keys};
     } else {
-        $self->source_path(shift @_);
-    }
-    
-    if ($self->source_path) {
-        (-e $self->source_path) or croak $self->source_path." is not found.\n";
-        $self->source_path($self->source_path);
-    }
-    
-    $self->link_attributes(['src', 'href', 'background', 'csref', 'livesrc']);
-    # 'livesrc' and 'csref' are uesed in Adobe GoLive
+        my $file = shift @_;
+        if (!ref($file) && (ref(\$file) ne "GLOB")) {
+            $self->source_path($file);
+        } else {
+            $self->source_handle($file);
+        }
+    }
+    
+    $self->link_attributes(\@default_link_attributes);
     $self->has_base(0);
     
     return $self;
@@ -133,28 +145,32 @@
 
 =head2 copy_to
 
-    $p->copy_to($destination_path)
-
-Parse contents of $source_path given in new method, change links and write into $destination_path.
+    $p->copy_to($destination)
+
+Parse contents of $source given in new method, change links and write into $destination.
+
+The argument $destination can be a file path or a file handle. When $destination is a file handle, you may need to indicate the location of the file handle by a method L<"destination_path">. L<"destination_path"> must be called before calling L<"copy_to">. When calling L<"destination_path"> is omitted, it is assumed that the locaiton of the file handle is the current working directory.
 
 =cut
 
 sub copy_to {
-    my ($self, $destination_path) = @_;
-    $destination_path = $self->set_destination($destination_path);
+    my ($self, $destination) = @_;
     my $io_layer = $self->io_layer();
-    
-    my $fh = IO::File->new($destination_path, ">$io_layer");
-    
-    if (defined $fh) {
-        $self->{'outputHTML'} = $fh;
-        $self->SUPER::parse($self->{'source_html'});
-        $self->eof;
-        $fh->close;
+    my $fh;
+    if (!ref($destination) && (ref(\$destination) ne "GLOB")) {
+        $destination = $self->set_destination($destination);
+        open $fh, ">$io_layer", $destination
+                             or croak "can't open $destination.";
     } else {
-        die "can't open $destination_path.";
-    }
-    
+        $fh = $destination;
+        binmode($fh, $io_layer);
+    }
+    
+    $self->{'output_handle'} = $fh;
+    $self->SUPER::parse($self->{'source_html'});
+    $self->eof;
+    close $fh;
+    $self->source_handle(undef);
     return $self->destination_path;
 }
 
@@ -162,32 +178,118 @@
 
     $p->parse_to($destination_path)
 
-Parse contents of $source_path given in new method, change links and return HTML contents to wirte $destination_path. Unlike copy_to, $destination_path will not created.
+Parse contents of $source_path given in new method, change links and return HTML contents to wirte $destination_path. Unlike copy_to, $destination_path will not created and just return modified HTML. The encoding of strings is converted into utf8.
 
 =cut
 
 sub parse_to {
     my ($self, $destination_path) = @_;
-    $destination_path = $self->set_destination($destination_path);
-    $self->io_layer;
+    $destination_path = $self->destination_path($destination_path);
     
     my $output = '';
-    my $fh = IO::File->new(\$output, ">:utf8");
-    $self->{'outputHTML'} = $fh;
-    $self->SUPER::parse($self->{'source_html'});
-    $self->eof;
-    $fh->close;
-    return decode_utf8($output);
+    open my $fh, ">", \$output;
+    $self->copy_to($fh);
+    return Encode::decode($self->encoding, $output);
 }
 
 =head1 ACCESSOR METHODS
+
+=head2 source_path
+
+    $p->source_path
+    $p->source_path($path)
+
+Get and set a source location. Usually source location is specified with the L<"new"> method. When a file handle is passed to L<"new"> and the location of the file handle is not the current working directory, you need to use this method.
+
+=cut
+
+sub source_path {
+    my $self = shift @_;
+    
+    if (@_) {
+        my $path = shift @_;
+        $self->{'source_path'} = $path;
+        $self->source_uri(URI::file->new_abs($path));
+    }
+    
+    return $self->{'source_path'};
+}
+
+
+=head2 destination_path
+
+    $p->destination_path
+    $p->destination_path($path)
+
+Get and set a destination location. Usually destination location is specified with the L<"copy_to">. When a file handle is passed to L<"copy_to"> and the location of the file handle is not the current working directory, you need to use this method before L<"copy_to">.
+
+=cut
+
+sub destination_path {
+    my $self = shift @_;
+    
+    if (@_) {
+        my $path = shift @_;
+        $self->{'destination_path'} = $path;
+        $self->destination_uri(URI::file->new_abs($path));
+    } 
+    
+    return $self->{'destination_path'};
+}
+
+=head2 enchoding
+
+    $p->encoding;
+
+Get an encoding of a source HTML.
+
+=cut
+
+sub encoding {
+    my ($self) = @_;
+    if ($self->{'encoding'}) {
+        return $self->{'encoding'};
+    }
+    
+    my $in = $self->source_handle;
+    my $data = do {local $/; <$in>;};
+    my $p = HTML::HeadParser->new;
+    $p->utf8_mode(1);
+    $p->parse($data);
+    my $content_type = $p->header('content-type');
+    my $encoding = '';
+    if ($content_type) {
+        if ($content_type =~ /charset\s*=(.+)/) {
+            $encoding = $1;
+        }
+    }
+    
+    unless ($encoding) {
+        my $decoder;
+        if (my @suspects = $self->encode_suspects) {
+            $decoder = Encode::Guess->guess($data, @suspects);
+        }
+        else {
+            $decoder = Encode::Guess->guess($data);
+        }
+        
+        ref($decoder) or 
+                    die("Can't guess encoding of ".$self->source_path);
+                    
+        $encoding = $decoder->name;
+    }
+    
+    $self->{'source_html'} = Encode::decode($encoding, $data);
+    $self->{'encoding'} = $encoding;
+    return $encoding;
+}
 
 =head2 io_layer
 
     $p->io_layer;
     $p->io_layer(':utf8');
 
-Get and set PerlIO layer to read $source_path and to write $destination_path. Usualy it was automatically determined by $source_path's charset tag. If charset is not specified, Encode::Guess module will be used.
+Get and set PerlIO layer to read the source path and to write the destination path. Usualy it was automatically determined by $source_path's charset tag. If charset is not specified, Encode::Guess module will be used.
 
 =cut
 
@@ -243,6 +345,11 @@
     $self->io_layer;
     return $self->{'source_html'};
 }
+
+=head1 NOTE
+
+Cleanuped pathes should be given to HTML::Copy and it's instances. For example, a verbose path like '/aa/bb/../cc' may cause converting links wrongly. This is a limitaion of the URI module's rel method. To cleanup pathes, Cwd::realpath is useful.
+
 
 =head1 AUTHOR
 
@@ -289,61 +396,36 @@
 
 ##== private functions
 
+sub complete_destination_path {
+    my ($self, $dir) = @_;
+    my $source_path = $self->source_path
+        or croak "Can't resolve a file name of the destination, because a source path is not given.";
+    my $filename = basename($source_path)
+        or croak "Can't resolve a file name of the destination, because given source path is a directory.";
+    return File::Spec->catfile($dir, $filename);
+    
+}
+    
 sub set_destination {
     my ($self, $destination_path) = @_;
-
+    
     if (-d $destination_path) {
-        my $file_name = basename($self->source_path);
-        $destination_path = File::Spec->catfile($destination_path, $file_name);
+        $destination_path = $self->complete_destination_path($destination_path);
     } else {
-        mkpath(dirname($destination_path));
+        my ($name, $dir) = fileparse($destination_path);
+        unless ($name) {
+            $destination_path = $self->complete_destination_path($destination_path);
+        }
+        
+        mkpath($dir);
     }
 
     return $self->destination_path($destination_path);
-}
-
-sub check_encoding {
-    my ($self) = @_;
-    my $data;
-    open my $in, "<", $self->source_path
-                    or die "Can't open $self->source_path.";
-    {local $/; $data = <$in>;}
-    close $in;
-    
-    my $p = HTML::HeadParser->new;
-    $p->utf8_mode(1);
-    $p->parse($data);
-    my $content_type = $p->header('content-type');
-    my $encoding = '';
-    if ($content_type) {
-        if ($content_type =~ /charset\s*=(.+)/) {
-            $encoding = $1;
-        }
-    }
-    
-    unless ($encoding) {
-        my $decoder;
-        if (my @suspects = $self->encode_suspects) {
-            $decoder = Encode::Guess->guess($data, @suspects);
-        }
-        else {
-            $decoder = Encode::Guess->guess($data);
-        }
-        
-        ref($decoder) or 
-                    die("Can't guess encoding of ".$self->source_path);
-                    
-        $encoding = $decoder->name;
-    }
-    
-    $self->{'source_html'} = Encode::decode($encoding, $data);
-    
-    return $encoding;
 }
 
 sub check_io_layer {
     my ($self) = @_;
-    my $encoding = $self->check_encoding;
+    my $encoding = $self->encoding;
     return '' unless ($encoding);
     
     my $io_layer = '';
@@ -388,29 +470,59 @@
 
 sub output {
     my ($self, $out_text) = @_;
-    $self->{'outputHTML'}->print($out_text);
-}
-
-sub source_path {
-    my $self = shift @_;
-    
-    if (@_) {
-        my $path = Cwd::abs_path(shift @_);
-        $self->{'source_path'} = $path;
-        $self->source_uri(URI::file->new($path));
-    }
-    return $self->{'source_path'};
-}
-
-sub destination_path {
-    my $self = shift @_;
-    
-    if (@_) {
-        my $path = Cwd::abs_path(shift @_);
-        $self->{'destination_path'} = $path;
-        $self->destination_uri(URI::file->new($path));
-    }
-    return $self->{'destination_path'};
-}
+    print {$self->{'output_handle'}} $out_text;
+}
+
+sub source_handle {
+    my $self = shift @_;
+    
+    if (@_) {
+        $self->{'source_handle'} = shift @_;
+    }
+    elsif (!$self->{'source_handle'}) {
+        my $path = $self->source_path or croak "source_paht is undefined.";
+        open my $in, "<", $path or croak "Can't open $path.";
+        $self->{'source_handle'} = $in;
+    }
+    
+    return $self->{'source_handle'}
+}
+
+sub source_uri {
+    my $self = shift @_;
+    if (@_) {
+        $self->{'source_uri'} = shift @_;
+    } elsif (!$self->{'source_uri'}) {
+        $self->{'source_uri'} = do {
+            if (my $path = $self->source_path) {
+                URI::file->new_abs($path);
+            } else {
+                URI::file->cwd;
+            }
+        }
+    } 
+    
+    return $self->{'source_uri'}
+}
+
+sub destination_uri {
+    my $self = shift @_;
+    
+    if (@_) {
+        $self->{'destination_uri'} = shift @_;
+    } elsif (!$self->{'destination_uri'}) {
+        $self->{'destination_uri'} = do {
+            if (my $path = $self->destination_path) {
+                URI::file->new_abs($path);
+            } else {
+                URI::file->cwd;
+            }
+        }
+    }
+    
+    return $self->{'destination_uri'};
+}
+
+
 
 1;

Modified: branches/upstream/libhtml-copy-perl/current/t/parse.t
URL: http://svn.debian.org/wsvn/branches/upstream/libhtml-copy-perl/current/t/parse.t?rev=17477&op=diff
==============================================================================
--- branches/upstream/libhtml-copy-perl/current/t/parse.t (original)
+++ branches/upstream/libhtml-copy-perl/current/t/parse.t Sat Mar 15 17:36:55 2008
@@ -4,11 +4,22 @@
 use warnings;
 use HTML::Copy;
 use utf8;
-use File::Spec;
+use File::Spec::Functions;
 #use Data::Dumper;
 
-use Test::More tests => 12;
-
+use Test::More tests => 16;
+
+sub read_and_unlink {
+    my ($path, $htmlcopy) = @_;
+    open(my $in, "<".$htmlcopy->io_layer(), $path)
+                                or die "Can't open $path.";
+    my $contents = do {local $/; <$in>};
+    close $in;
+    unlink($path);
+    return $contents;
+}
+
+##== prepare linked HTML file
 my $linked_html = <<EOT;
 <!DOCTYPE html>
 <html>
@@ -16,7 +27,8 @@
 EOT
 
 my $linked_file_name = "linked$$.html";
-open(my $linked_fh, ">", $linked_file_name);
+open(my $linked_fh, ">", $linked_file_name)
+                or die "Can't open $linked_file_name.";
 print $linked_fh $linked_html;
 close $linked_fh;
 
@@ -49,10 +61,11 @@
 my $sub_dir_name = "sub$$";
 mkdir($sub_dir_name);
 my $src_file_name = "file$$.html";
-my $destination = File::Spec->catfile($sub_dir_name, $src_file_name);
+my $destination = catfile($sub_dir_name, $src_file_name);
 
 ##== Test code with no charsets HTML
-open(my $src_fh, ">:utf8", $src_file_name);
+open(my $src_fh, ">:utf8", $src_file_name) 
+                            or die "Can't open $src_file_name.";
 print $src_fh $source_html_nocharset;
 close $src_fh;
 
@@ -64,31 +77,34 @@
 
 ##=== copty_to UTF8
 $p->copy_to($destination);
-open(my $in, "<".$p->io_layer(), $destination);
-{local $/; $copy_html = <$in>};
-close $in;
-unlink($destination);
+open(my $in, "<".$p->io_layer(), $destination)
+                            or die "Can't open $destination.";
+$copy_html = read_and_unlink($destination, $p);
 
 ok($copy_html eq $result_html_nocharset, "copy_to no charset UTF-8");
 
 ##=== write data with shift_jis
-open($src_fh, ">:encoding(shiftjis)", $src_file_name);
+open($src_fh, ">:encoding(shiftjis)", $src_file_name)
+                            or die "Can't open $src_file_name.";
 print $src_fh $source_html_nocharset;
 close $src_fh;
 
 ##=== parse_to shift_jis
 $p = HTML::Copy->new($src_file_name);
-$p->encode_suspects("shiftjis");
-$copy_html = $p->parse_to("$sub_dir_name/$src_file_name");
+$copy_html = do {
+    $p->encode_suspects("shiftjis");
+    $p->parse_to(catfile($sub_dir_name, $src_file_name));
+};
 
 ok($copy_html eq $result_html_nocharset, "parse_to no charset shift_jis");
 
 ##=== copy_to shift_jis
-$p->copy_to($destination);
-open($in, "<".$p->io_layer, $destination);
-{local $/; $copy_html = <$in>};
-close $in;
-unlink($destination);
+$copy_html = do {
+    $p->copy_to($destination);
+    open(my $in, "<".$p->io_layer, $destination)
+                        or die "Can't open $destination.";
+    read_and_unlink($destination, $p);
+};
 
 ok($copy_html eq $result_html_nocharset, "copy_to no charset shift_jis");
 
@@ -99,12 +115,14 @@
 <head>
 <meta http-equiv="content-type" content="text/html;charset=utf-8">
 </head>
+<body>
 ああ
 <a href="$linked_file_name"></a>
 <frame src="$linked_file_name">
 <img src="$linked_file_name">
 <script src="$linked_file_name"></script>
 <link href="$linked_file_name">
+</body>
 </html>
 EOT
 
@@ -114,34 +132,80 @@
 <head>
 <meta http-equiv="content-type" content="text/html;charset=utf-8">
 </head>
+<body>
 ああ
 <a href="../$linked_file_name"></a>
 <frame src="../$linked_file_name">
 <img src="../$linked_file_name">
 <script src="../$linked_file_name"></script>
 <link href="../$linked_file_name">
+</body>
 </html>
 EOT
 
 ##== Test code with charset utf-8
-open($src_fh, ">:utf8", $src_file_name);
+open($src_fh, ">:utf8", $src_file_name)
+                or die "Can't open $src_file_name.";
 print $src_fh $src_html_utf8;
 close $src_fh;
 
 ##=== parse_to
 $p = HTML::Copy->new($src_file_name);
+
 $copy_html = $p->parse_to($destination);
 
 ok($copy_html eq $result_html_utf8, "parse_to charset UTF-8");
 
 ##=== copy_to
 $p->copy_to($destination);
-open($in, "<".$p->io_layer(), $destination);
-{local $/; $copy_html = <$in>};
-close $in;
-unlink($destination);
+$copy_html = read_and_unlink($destination, $p);
 
 ok($copy_html eq $result_html_utf8, "copy_to charset UTF-8");
+
+##=== copy_to gving a file handle
+$copy_html = do {
+    open $in, "<", \$src_html_utf8;
+    my $outdata ='';;
+    my $p = HTML::Copy->new($in);
+    open my $out, ">", $destination;
+    $p->destination_path($destination);
+    $p->copy_to($out);
+    close $out;
+    read_and_unlink($destination, $p);
+};
+
+ok($copy_html eq $result_html_utf8, "copy_to giviing a file handle");
+
+##=== copy_to gving file handles for input and output
+$copy_html = do {
+    open my $in, "<", \$src_html_utf8;
+    my $outdata;
+    my $p = HTML::Copy->new($in);
+    open my $out, ">".$p->io_layer(), \$outdata;
+    $p->destination_path($destination);
+    $p->copy_to($out);
+    Encode::decode($p->encoding, $outdata);
+};
+
+ok($copy_html eq $result_html_utf8, "copy_to giviing file handles for input and output");
+
+##=== parse_to giving a file handle
+$copy_html = do {
+    open my $in, "<", \$src_html_utf8;
+    my $p = HTML::Copy->new($in);
+    $p->parse_to($destination);
+};
+
+ok($copy_html eq $result_html_utf8, "copy_to giviing file handles for input and output");
+
+##=== copy_to with directory destination
+$copy_html = do {
+    my $p = HTML::Copy->new($src_file_name);
+    my $destination = $p->copy_to($sub_dir_name);
+    read_and_unlink($destination, $p);
+};
+
+ok($copy_html eq $result_html_utf8, "copy_to with a directory destination");
 
 ##== HTML with charset shift_jis
 my $src_html_shiftjis = <<EOT;
@@ -175,7 +239,8 @@
 EOT
 
 ##== Test code with charset shift_jis
-open($src_fh, ">:encoding(shiftjis)", $src_file_name);
+open($src_fh, ">:encoding(shiftjis)", $src_file_name)
+                        or die "Can't open $src_file_name.";
 print $src_fh $src_html_shiftjis;
 close $src_fh;
 
@@ -188,12 +253,9 @@
 
 ##=== copy_to
 $p->copy_to($destination);
-open($in, "<".$p->io_layer, $destination);
-{local $/; $copy_html = <$in>};
-close $in;
+$copy_html = read_and_unlink($destination, $p);
 
 ok($copy_html eq $result_html_shiftjis, "copy_to no charset shift_jis");
-unlink($destination);
 
 ##== class_methods
 $copy_html = HTML::Copy->parse_file($src_file_name, $destination);
@@ -202,7 +264,8 @@
 
 HTML::Copy->htmlcopy($src_file_name, $destination);
 
-open($in, "<".$p->io_layer, $destination);
+open($in, "<".$p->io_layer, $destination)
+                                or die "Can't open $destination.";
 {local $/; $copy_html = <$in>};
 close $in;
 
@@ -228,7 +291,8 @@
 EOT
 
 ##== Test code with base url
-open($src_fh, ">:utf8", $src_file_name);
+open($src_fh, ">:utf8", $src_file_name)
+                    or die "Can't open $destination.";
 print $src_fh $src_html_base;
 close $src_fh;
 
@@ -239,7 +303,8 @@
 
 ##=== copy_to
 $p->copy_to($destination);
-open($in, "<".$p->io_layer, $destination);
+open($in, "<".$p->io_layer, $destination)
+                            or die "Can't open $destination.";
 {local $/; $copy_html = <$in>};
 close $in;
 
@@ -248,3 +313,4 @@
 
 unlink($linked_file_name, $src_file_name, $destination);
 rmdir($sub_dir_name);
+




More information about the Pkg-perl-cvs-commits mailing list