File Coverage

blib/lib/HTML/SiteTear/Root.pm

Criterion	Covered	Total	%
statement	18	55	32.7
branch	0	2	0.0
condition	0	3	0.0
subroutine	6	16	37.5
pod	6	10	60.0
total	30	86	34.8

package HTML::SiteTear::Root;

use strict;
use warnings;
use File::Spec;
use File::Basename;
#use Cwd;
use URI::file;
use base qw(Class::Accessor);
HTML::SiteTear::Root->mk_accessors(qw(source_path
                                    source_root_uri
                                    resource_folder_name
                                    page_folder_name
                                    target_path
                                    site_root_path
                                    site_root_file_uri
                                    site_root_uri
                                    allow_abs_link
                                    only_subitems));
#use Data::Dumper;

our $VERSION = '1.43';

=head1 NAME

HTML::SiteTear::Root - a root object in a parent chain.

=head1 SYMPOSIS

  use HTML::SiteTear::Root;

  $root = HTML::SiteTear::Root->new('source_path' => $source_path,
                                    'target_path' => $destination_path);

=head1 DESCRIPTION

An instanece of this module is for a root object in a parent chain and manage a relation tabel of all source pathes and target pathes. Also gives default folder names.

=cut

our $defaultpage_folder_name = 'pages';
our $defaultresource_folder_name = 'assets';

=head1 METHODS

=head2 new

    $root = HTML::SiteTear::Root->new('source_path' => $source_path,
                                      'target_path' => $destination_path);

make a new instance.

=cut

sub new {
    my $class = shift @_;
    my %args = @_;
    my $self = $class->SUPER::new(\%args);
    $self->{'fileMapRef'} = {};
    $self->{'copiedFiles'} = [];
    $self->set_default_folder_names;

    if ($self->site_root_path and $self->site_root_uri) {
        $self->allow_abs_link(1);
        $self->site_root_file_uri(URI::file->new($self->site_root_path));
        $self->site_root_uri(URI->new($self->site_root_uri));
    }
    $self->source_root_uri(URI::file->new($self->source_path));
    return $self;
}

sub set_default_folder_names {
    my ($self) = @_;
    $self->resource_folder_name($defaultresource_folder_name);
    $self->page_folder_name($defaultpage_folder_name);
}

=head2 add_to_copyied_files

    $item->add_to_copyied_files($source_path)

Add a file path already copied to the copiedFiles table of the root object of the parent chain.

=cut

sub add_to_copyied_files {
    my ($self, $path) = @_;
    #$path = Cwd::realpath($path);
    push @{$self->{'copiedFiles'}}, $path;
    return $path;
}

=head2 exists_in_copied_files

    $item->exists_in_copied_files($source_path)

Check existance of $source_path in the copiedFiles entry.

=cut

sub exists_in_copied_files {
    my ($self, $path) = @_;
    return grep(/^$path$/, @{$self->{'copiedFiles'}});
}

=head2 add_to_filemap

    $root->add_to_filemap($source_path, $destination_uri);

Add to copyied file information into the internal table "filemap".
A fragment of $destination_uri is dropped.

=cut

sub add_to_filemap {
    my ($self, $source_path, $destination_uri) = @_;
    $destination_uri->fragment(undef);
    $self->{'fileMapRef'}->{$source_path} = $destination_uri;
    return $destination_uri;
}

=head2 exists_in_filemap

    $root->exists_in_filemap($source_path);

check $source_path is entry in FileMap

=cut

sub exists_in_filemap {
    my ($self, $path) = @_;
    return exists($self->{fileMapRef}->{$path});
}

sub item_in_filemap {
    my ($self, $path) = @_;
    return $self->{'fileMapRef'}->{$path};
}

=head2 rel_for_mappedfile

    $root->rel_for_mappedfile($source_path, $base_uri);

get relative URI of copied file of $source_path from $base_uri.

=cut

sub rel_for_mappedfile {
    my ($self, $source_path, $base_uri) = @_;
    my $target_uri = $self->{'fileMapRef'}->{$source_path};
    return $target_uri->rel($base_uri);
}

sub source_root_path {
    my $self = shift @_;
    return $self->source_path;
}

sub source_root {
    my $self = shift @_;
    return $self
}

=head1 SEE ALSO

L, L, L, L

=head1 AUTHOR

Tetsuro KURITA

=cut

1;