File Coverage

blib/lib/HTML/Links/Localize.pm

Criterion	Covered	Total	%
statement	17	131	12.9
branch	0	42	0.0
condition	0	13	0.0
subroutine	6	21	28.5
pod	4	4	100.0
total	27	211	12.8

package HTML::Links::Localize;
$HTML::Links::Localize::VERSION = '0.2.11';
use strict;
use warnings;

use 5.008;

use HTML::TokeParser ();
use File::Find qw/ find /;
use File::Copy qw/ copy /;

# Two utility functions
sub _is_older
{
    my $file1 = shift;
    my $file2 = shift;
    my @stat1 = stat($file1);
    my @stat2 = stat($file2);
    return ( $stat1[9] <= $stat2[9] );
}

sub _is_newer
{
    my $file1 = shift;
    my $file2 = shift;
    return ( !_is_older( $file1, $file2 ) );
}

sub new
{
    my $class = shift;
    my $self  = {};
    bless $self, $class;

    $self->_init(@_);

    return $self;
}

sub _set_base_dir
{
    my $self = shift;

    my $base_dir = shift;

    $base_dir =~ s{/*$}{/};

    $self->{'base_dir'} = $base_dir;

    return 0;
}

sub _get_base_dir
{
    my $self = shift;

    return $self->{'base_dir'};
}

sub _set_dest_dir
{
    my $self = shift;

    my $dest_dir = shift;

    $self->{'dest_dir'} = $dest_dir;

    return 0;
}

sub _get_dest_dir
{
    my $self = shift;

    return $self->{'dest_dir'};
}

sub _init
{
    my $self = shift;

    my %args = @_;

    $self->_set_base_dir( $args{'base_dir'} || "." );

    $self->_set_dest_dir( $args{'dest_dir'} || "./dest" );

    return 0;
}

sub process_content
{
    my $self = shift;

    my $fh = shift;

    my $out_content = "";

    my $out = sub {
        $out_content .= join( "", @_ );
    };

    my $parser = HTML::TokeParser->new($fh);
    while ( my $token = $parser->get_token() )
    {
        my $type = $token->[0];
        if ( $type eq "E" )
        {
            $out->( $token->[2] );
        }
        elsif ( $type eq "C" )
        {
            $out->( $token->[1] );
        }
        elsif ( $type eq "T" )
        {
            $out->( $token->[1] );
        }
        elsif ( $type eq "D" )
        {
            $out->( $token->[1] );
        }
        elsif ( $type eq "PI" )
        {
            $out->( $token->[2] );
        }
        elsif ( $type eq "S" )
        {
            my $tag          = $token->[1];
            my %process_tags = (
                'form' => { 'action' => 1 },
                'img'  => { 'src'    => 1 },
                'a'    => { 'href'   => 1 },
                'link' => { 'href'   => 1 },
            );
            if ( exists( $process_tags{$tag} ) )
            {
                my $ret           = "<$tag";
                my $attrseq       = $token->[3];
                my $attr_values   = $token->[2];
                my $process_attrs = $process_tags{$tag};
                foreach my $attr (@$attrseq)
                {
                    my $value = $attr_values->{$attr};
                    if ( exists( $process_attrs->{$attr} ) )
                    {
                        # If it's a local link that ends with slash -
                        # then append index.html
                        if (   ( $value !~ /^[a-z]+:/ )
                            && ( $value !~ /^\// )
                            && ( $value =~ /\/(#[^#\/]*)?$/ ) )
                        {
                            my $pos = rindex( $value, "/" );
                            substr( $value, $pos + 1, 0 ) = "index.html";
                        }
                    }
                    if ( $attr eq "/" )
                    {
                        $ret .= " /";
                    }
                    else
                    {
                        $ret .= " $attr=\"$value\"";
                    }
                }
                $out->($ret);
                $out->(">");
            }
            else
            {
                $out->( $token->[4] );
            }
        }
    }

    return $out_content;
}

sub process_file
{
    my $self     = shift;
    my $filename = shift;

    my $dest_dir = $self->_get_dest_dir();
    my $src_dir  = $self->_get_base_dir();

    open my $in, '<', "$src_dir/$filename"
        or die "Cannot open '$src_dir/$filename' - $!";
    open my $out, '>', "$dest_dir/$filename"
        or die "Cannot open '$dest_dir/$filename' for writing- $!";
    print {$out} $self->process_content($in);
    close($in);
    close($out);
}

sub process_dir_tree
{
    my $self = shift;

    my %args = @_;

    my $should_replace_file = sub {
        my ( $src, $dest ) = @_;
        if ( $args{'only-newer'} )
        {
            return ( ( !-e $dest ) || ( _is_newer( $src, $dest ) ) );
        }
        else
        {
            return 1;
        }
    };

    my $src_dir  = $self->_get_base_dir();
    my $dest_dir = $self->_get_dest_dir();

    my ( @dirs, @other_files, @html_files );

    my $wanted = sub {
        my $filename = $File::Find::name;
        if ( length($filename) < length($src_dir) )
        {
            return;
        }

        # Remove the $src_dir from the filename;
        $filename = substr( $filename, length($src_dir) );

        if ( -d $_ )
        {
            push @dirs, $filename;
        }
        elsif (/\.html?$/)
        {
            push @html_files, $filename;
        }
        else
        {
            push @other_files, $filename;
        }
    };

    find( $wanted, $src_dir );

    my $soft_mkdir = sub {
        my $dir = shift;
        if ( -d $dir )
        {
            # Do nothing
        }
        elsif ( -e $dir )
        {
            die "$dir exists in destination and is not a directory";
        }
        else
        {
            mkdir($dir) || die "mkdir failed: $!\n";
        }
    };

    # Create the directory structure in $dest

    $soft_mkdir->($dest_dir);
    foreach my $dir (@dirs)
    {
        $soft_mkdir->("$dest_dir/$dir");
    }

    foreach my $file (@other_files)
    {
        my $src  = "$src_dir/$file";
        my $dest = "$dest_dir/$file";
        if ( $should_replace_file->( $src, $dest ) )
        {
            copy( $src, $dest );
        }
    }

    foreach my $file (@html_files)
    {
        my $src  = "$src_dir/$file";
        my $dest = "$dest_dir/$file";
        if ( $should_replace_file->( $src, $dest ) )
        {
            $self->process_file($file);
        }
    }

    return 0;
}

1;

__END__