File Coverage

blib/lib/VLGal/File.pm

Criterion	Covered	Total	%
statement	52	214	24.3
branch	11	80	13.7
condition	6	32	18.7
subroutine	13	27	48.1
pod	9	19	47.3
total	91	372	24.4

package VLGal::File;

use 5.006;
use strict;
use warnings;
use Error qw(:try);
use File::Basename;
use VLGal::Style;

# Used by _value_is_allowed
our %ALLOW_ISA = (
    'super_dir' => [ 'VLGal::Directory' ],
);

# Used by _value_is_allowed
our %ALLOW_REF = (
);

# Used by _value_is_allowed
our %ALLOW_RX = (
);

# Used by _value_is_allowed
our %ALLOW_VALUE = (
);

# Package version
our ($VERSION) = '$Revision: 0.01 $' =~ /\$Revision:\s+([^\s]+)/;

=head1 NAME

VLGal::File - Vincenzo's little gallery file

=head1 SYNOPSIS

None. This is an abstract class.

=head1 ABSTRACT

Vincenzo's little gallery file

=head1 DESCRIPTION

C is an abstract class that describes generic properties of Vincenzo's little gallery file.

=head1 CONSTRUCTOR

=over

=item new( [ OPT_HASH_REF ] )

Creates a new C object. C is a hash reference used to pass initialization options. On error an exception C is thrown.

Options for C may include:

=over

=item B>

Passed to L.

=item B>

Passed to L.

=item B>

Passed to L.

=back

=back

=head1 METHODS

=over

=item get_basename()

Returns the file's base name.

=item get_dirname()

Returns the file's directory name.

=item get_super_dir()

Returns the super directory in the file system.

=item mk_fs_name()

Makes the file systemn name of the object usinf C and C.

=item mk_vlgal_dir_name()

Makes the name of the C<.vlgal> directory.

=item set_basename(VALUE)

Set the file's base name. C is the value. On error an exception C is thrown.

=item set_dirname(VALUE)

Set the file's directory name. C is the value. On error an exception C is thrown.

=item set_super_dir(VALUE)

Set the super directory in the file system. C is the value. On error an exception C is thrown.

=over

=item VALUE must be a (sub)class of:

=over

=item VLGal::Directory

=back

=back

=back

=head1 SEE ALSO

L,
L,
L,
L,
L

=head1 BUGS

None known (yet.)

=head1 HISTORY

First development: September 2003
Last update: October 2003

=head1 AUTHOR

Vincenzo Zocca

=head1 COPYRIGHT

Copyright 2003 by Vincenzo Zocca

=head1 LICENSE

This file is part of the C module hierarchy for Perl by
Vincenzo Zocca.

The VLGal module hierarchy is free software; you can redistribute it
and/or modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2 of
the License, or (at your option) any later version.

The VLGal module hierarchy is distributed in the hope that it will
be useful, but WITHOUT ANY WARRANTY; without even the implied
warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with the VLGal module hierarchy; if not, write to
the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
Boston, MA 02111-1307 USA

=cut

sub new {
    my $class = shift;

    my $self = {};
    bless( $self, ( ref($class) || $class ) );
    return( $self->_initialize(@_) );
}

sub _initialize {
    my $self = shift;
    my $opt = defined($_[0]) ? shift : {};

    # Check $opt
    ref($opt) eq 'HASH' || throw Error::Simple("ERROR: VLGal::File::_initialize, first argument must be 'HASH' reference.");

    # basename, SINGLE
    exists( $opt->{basename} ) && $self->set_basename( $opt->{basename} );

    # dirname, SINGLE
    exists( $opt->{dirname} ) && $self->set_dirname( $opt->{dirname} );

    # super_dir, SINGLE
    exists( $opt->{super_dir} ) && $self->set_super_dir( $opt->{super_dir} );

    # Return $self
    return($self);
}

sub _value_is_allowed {
    my $name = shift;

    # Value is allowed if no ALLOW clauses exist for the named attribute
    if ( ! exists( $ALLOW_ISA{$name} ) && ! exists( $ALLOW_REF{$name} ) && ! exists( $ALLOW_RX{$name} ) && ! exists( $ALLOW_VALUE{$name} ) ) {
        return(1);
    }

    # At this point, all values in @_ must to be allowed
    CHECK_VALUES:
    foreach my $val (@_) {
        # Check ALLOW_ISA
        if ( ref($val) && exists( $ALLOW_ISA{$name} ) ) {
            foreach my $class ( @{ $ALLOW_ISA{$name} } ) {
                &UNIVERSAL::isa( $val, $class ) && next CHECK_VALUES;
            }
        }

        # Check ALLOW_REF
        if ( ref($val) && exists( $ALLOW_REF{$name} ) ) {
            exists( $ALLOW_REF{$name}{ ref($val) } ) && next CHECK_VALUES;
        }

        # Check ALLOW_RX
        if ( defined($val) && ! ref($val) && exists( $ALLOW_RX{$name} ) ) {
            foreach my $rx ( @{ $ALLOW_RX{$name} } ) {
                $val =~ /$rx/ && next CHECK_VALUES;
            }
        }

        # Check ALLOW_VALUE
        if ( ! ref($val) && exists( $ALLOW_VALUE{$name} ) ) {
            exists( $ALLOW_VALUE{$name}{$val} ) && next CHECK_VALUES;
        }

        # We caught a not allowed value
        return(0);
    }

    # OK, all values are allowed
    return(1);
}

sub diff_html_dir {
    my $self = shift;
    my $to_file = shift;

    $to_file ||
        return('');

    my @from_dir = ();
    my $runner = $self;
    while (my $super_dir = $runner->get_super_dir() ) {
        unshift( @from_dir, $super_dir );
        $runner = $super_dir;
    }

    my @to_dir = ();
    $runner = $to_file;
    while (my $super_dir = $runner->get_super_dir() ) {
        unshift( @to_dir, $super_dir );
        $runner = $super_dir;
    }

    while (1) {
        scalar( @from_dir ) && scalar( @to_dir ) ||
            last;
        ( $from_dir[0] != $to_dir[0] ) &&
            last;
        shift( @from_dir );
        shift( @to_dir );
    }

    my $diff = '../' x scalar( @from_dir );
    foreach my $file ( @to_dir ) {
        $diff .= $file->get_basename() . '/';
    }
    return( $diff );
}

sub generate {
    throw Error::Simple("ERROR: VLGal::File::generate, call this method in a subclass that has implemented it.");
}

sub generate_html {
    my $self = shift;
    my $fn = shift;
    my $super_html_dir = shift;
    my $prev_file = shift;
    my $next_file = shift;
    my $size = shift;

    # Make code easier to read with $style
    my $style = VLGal::Style->instance();

    # Print verbose message
    $style->is_verbose() &&
        print STDERR "Making file '$fn'.\n";

    # Open the index-vlgal.html file
    my $fh = IO::File->new( $fn, 'w' );
    defined($fh) ||
        throw Error::Simple("ERROR: VLGal::File::generate_html, failed to open file '$fn' for writing.");

    # Write the first part of the html header
    my $basename = $self->get_basename();
    $fh->print(<



       </td>
</tr>

<tr>
<td  class="h" >
<a name="310">310</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> EOF </td>
</tr>

<tr>
<td  class="h" >
<a name="311">311</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> &nbsp; </td>
</tr>

<tr>
<td  class="h" >
<a name="312">312</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">     # Write the css part of the html header </td>
</tr>

<tr>
<td  class="h" >
<a name="313">313</a>
</td>

<td  class="c0" >

0

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

0

</td>

<td class="s">     my $css_fh = IO::File->new( $style->get_css_definition_file() ); </td>
</tr>

<tr>
<td  class="h" >
<a name="314">314</a>
</td>

<td  class="c0" >

0

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

0

</td>

<td class="s">     while (my $line = $css_fh->getline() ) { </td>
</tr>

<tr>
<td  class="h" >
<a name="315">315</a>
</td>

<td  class="c0" >

0

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

0

</td>

<td class="s">         $fh->print($line); </td>
</tr>

<tr>
<td  class="h" >
<a name="316">316</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">     } </td>
</tr>

<tr>
<td  class="h" >
<a name="317">317</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> &nbsp; </td>
</tr>

<tr>
<td  class="h" >
<a name="318">318</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">     # Write the remaining part of the html header </td>
</tr>

<tr>
<td  class="h" >
<a name="319">319</a>
</td>

<td  class="c0" >

0

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

0

</td>

<td class="s">     $fh->print(<<EOF); </td>
</tr>

<tr>
<td  class="h" >
<a name="320">320</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">
      Gallery of $basename


     




325




 





 





 





 





 





 



        




326




 





 





 





 





 





 



          




327




 





 





 





 





 





 



 EOF 




328




 





 





 





 





 





 



   




329




0





 





 





 





 





0



     $self->generate_td_cont_prev( $fh, $size ); 




330




 





 





 





 





 





 



   




331




0





 





 





 





 





0



     $fh->print(<




332




 





 





 





 





 





 



          




333




 





 





 





 





 





 



          




334




 





 





 





 





 





 



 EOF 




335




 





 





 





 





 





 



   




336




0





 





 





 





 





0



     $self->generate_td_cont_next( $fh, $size ); 




337




 





 





 





 





 





 



   




338




0





 





 





 





 





0



     $fh->print(<




339




 





 





 





 





 





 



          




340




 





 





 





 





 





 



          




341




 





 





 





 





 





 



 EOF 




342




 





 





 





 





 





 



   




343




 





 





 





 





 





 



     # Write super directory access line 




344




0





 





 





 





 





0



     my @super = (); 




345




0





 





 





 





 





0



     my $runner = $self; 




346




0





 





 





 





 





0



     while ( my $super = $runner->get_super_dir() ) { 




347




0





 





 





 





 





0



         push( @super, $super ); 




348




0





 





 





 





 





0



         $runner = $super; 




349




 





 





 





 





 





 



     } 




350




0





 





 





 





 





0



     $fh->print(<




351




 





 





 





 





 





 



           Path: 




352




 





 





 





 





 





 



 EOF 




353




0





 





 





 





 





0



     for ( my $i = scalar( @super ) - 1; $i >= 0; $i-- ) { 




354




0





 





 





 





 





0



         my $super_base = $super[$i]->get_basename(); 




355




0





 





 





 





 





0



         my $super_dir = '../' x $i; 




356




0





 





 





 





 





0



         $fh->print(<




357




 





 





 





 





 





 



           $super_base / 




358




 





 





 





 





 





 



 EOF 




359




 





 





 





 





 





 



     } 




360




0





 





 





 





 





0



     $fh->print(<




361




 





 





 





 





 





 



           $basename 




362




 





 





 





 





 





 



          




363




 





 





 





 





 





 



 EOF 




364




 





 





 





 





 





 



   




365




 





 





 





 





 





 



     # Close navigation table 




366




0





 





 





 





 





0



     $fh->print(<




367




 





 





 





 





 





 



        




368


EOF

    $self->generate_td_cont_prev( $fh, $size );

    $fh->print(<


EOF

    $self->generate_td_cont_next( $fh, $size );

    $fh->print(<


EOF

    # Write super directory access line
    my @super = ();
    my $runner = $self;
    while ( my $super = $runner->get_super_dir() ) {
        push( @super, $super );
        $runner = $super;
    }
    $fh->print(<
          Path:
EOF
    for ( my $i = scalar( @super ) - 1; $i >= 0; $i-- ) {
        my $super_base = $super[$i]->get_basename();
        my $super_dir = '../' x $i;
        $fh->print(<
          $super_base /
EOF
    }
    $fh->print(<
          $basename

EOF

    # Close navigation table
    $fh->print(<



EOF

    # Make the image
    my $img_dir = '';
    if ( ! $size->get_max_height() || ! $size->get_max_width()  ) {
        $img_dir = '../../';
    }
    $fh->print(<


EOF

    # Generate sizes
    $self->generate_size(
        $fh,
        $size,
    );

    # Close html file
    $fh->print(<


EOF
}

sub generate_size {
    my $self = shift;
    my $fh = shift;
    my $skip_size = shift;

    $fh->print(<
    Size:
EOF

    my $i = -1;
    my $size_nr = scalar( VLGal::Style->instance()->get_size() );
    foreach my $size ( VLGal::Style->instance()->get_size() ) {
        $i++;
        $i > 0 ||
            next;

        my $label = $size->get_label();
        my $size_base = $size->get_basename();
        my $basename = $self->get_basename();
        if ( $i == 1 ) {
            $label = "(default) $label";
        }

        my $slash;
        if ( $i == $size_nr - 1 ) {
            $slash = '';
        }
        else {
            $slash = ' /';
        }

        if ( $skip_size == $size ) {
            $fh->print(<
    $label${slash}
EOF
        }
        else {
            $fh->print(<
     $label ${slash}
EOF
        }
    }
}

sub generate_table_td {
    my $self = shift;
    my $fh = shift;
    my $icon_dir = shift;
    my $href_tmpl = shift;

    # Start table data
    $fh->print(<

EOF

    # Start anchor
    my $basename = $self->get_basename();
    $href_tmpl =~ s/__BASENAME__/$basename/g;
    $fh->print(<

EOF

    # Icon and text in anchor
    $fh->print(<

            $basename
EOF

    # Print basename

    # End anchor
    $fh->print(<

EOF

    # End table data
    $fh->print(<

EOF
}

sub generate_td_cont_next {
    my $self = shift;
    my $fh = shift;
    my $size = shift;

    # Get next
    my $next_file = $self->get_next_in_hier();

    # Return if none
    $next_file ||
        return();

    # Make code easier to read with $style
    my $style = VLGal::Style->instance();

    # Make the next path
    my $href = $self->diff_html_dir( $next_file );
    my $icon;
    if ( $href ) {
        $href = '../../' . $href . '.vlgal/' . $size->get_basename() . '/' . $next_file->get_basename();
        $icon = '../icon/' . basename( $style->get_image_icon_next_seq() );
    }
    else {
        $href = $href . $next_file->get_basename();
        $icon = '../icon/' . basename( $style->get_image_icon_next_peer() );
    }
    $fh->print(<



EOF
}

sub generate_td_cont_prev {
    my $self = shift;
    my $fh = shift;
    my $size = shift;

    # Get previous
    my $prev_file = $self->get_previous_in_hier();

    # Return if none
    $prev_file ||
        return();

    # Make code easier to read with $style
    my $style = VLGal::Style->instance();

    # Make the previous path
    my $href = $self->diff_html_dir( $prev_file );
    my $icon;
    if ( $href ) {
        $href = '../../' . $href . '.vlgal/' . $size->get_basename() . '/' . $prev_file->get_basename();
        $icon = '../icon/' . basename( $style->get_image_icon_previous_seq() );
    }
    else {
        $href = $href . $prev_file->get_basename();
        $icon = '../icon/' . basename( $style->get_image_icon_previous_peer() );
    }
    $fh->print(<



EOF
}

sub get_basename {
    my $self = shift;

    return( $self->{VLGal_File}{basename} );
}

sub get_dirname {
    my $self = shift;

    return( $self->{VLGal_File}{dirname} );
}

sub get_next_in_hier {
    my $self = shift;

    $self->get_super_dir() ||
        return(undef);

    my $seq_hier = $self->get_root_dir()->get__all_file_();
    my $i = $seq_hier->[1]{$self};

    for ( my $j = $i + 1; $j < scalar( @{ $seq_hier->[0] } ); $j++ ) {
        if ( $self->isa( 'VLGal::Directory' ) ) {
            $seq_hier->[0][$j]->isa( 'VLGal::Directory' ) &&
                return( $seq_hier->[0][$j] );
        }
        else {
            $seq_hier->[0][$j]->isa( 'VLGal::Directory' ) ||
                return( $seq_hier->[0][$j] );
        }
    }
}

sub get_previous_in_hier {
    my $self = shift;

    $self->get_super_dir() ||
        return(undef);

    my $seq_hier = $self->get_root_dir()->get__all_file_();
    my $i = $seq_hier->[1]{$self};

    for ( my $j = $i - 1; $j >= 0; $j-- ) {
        if ( $self->isa( 'VLGal::Directory' ) ) {
            $seq_hier->[0][$j]->isa( 'VLGal::Directory' ) &&
                return( $seq_hier->[0][$j] );
        }
        else {
            $seq_hier->[0][$j]->isa( 'VLGal::Directory' ) ||
                return( $seq_hier->[0][$j] );
        }
    }
}

sub get_root_dir {
    my $self = shift;

    my $root = undef;
    $root = $self if ( $self->isa('VLGal::Directory') );
    my $super = $self;
    while ( $super = $super->get_super_dir() ) {
        $root = $super;
    }
    return($root);
}

sub get_super_dir {
    my $self = shift;

    return( $self->{VLGal_File}{super_dir} );
}

sub mk_fs_name {
    my $self = shift;

    return( File::Spec->catfile( $self->get_dirname(), $self->get_basename() ) );
}

sub mk_vlgal_dir_name {
    my $self = shift;

    return( File::Spec->catfile( $self->get_dirname(), '.vlgal' ) );
}

sub set_basename {
    my $self = shift;
    my $val = shift;

    # Check if isa/ref/rx/value is allowed
    &_value_is_allowed( 'basename', $val ) || throw Error::Simple("ERROR: VLGal::File::set_basename, the specified value '$val' is not allowed.");

    # Assignment
    $self->{VLGal_File}{basename} = $val;
}

sub set_dirname {
    my $self = shift;
    my $val = shift;

    # Check if isa/ref/rx/value is allowed
    &_value_is_allowed( 'dirname', $val ) || throw Error::Simple("ERROR: VLGal::File::set_dirname, the specified value '$val' is not allowed.");

    # Assignment
    $self->{VLGal_File}{dirname} = $val;
}

sub set_super_dir {
    my $self = shift;
    my $val = shift;

    # Check if isa/ref/rx/value is allowed
    &_value_is_allowed( 'super_dir', $val ) || throw Error::Simple("ERROR: VLGal::File::set_super_dir, the specified value '$val' is not allowed.");

    # Assignment
    $self->{VLGal_File}{super_dir} = $val;
}

1;