view release on metacpan or  search on metacpan

lib/PostScript/CDCover.pm  view on Meta::CPAN

# Fixed starting depth and difference between files and dirs depth
#
# Revision 1.4  2004/05/21 20:51:45  cbouvi
# Moved all the functionality to PostScript::CDCover
#
# Revision 1.3  2004/05/10 21:26:48  cbouvi
# Added $VERSION
#
# Revision 1.2  2004/05/04 21:21:31  cbouvi
# Added output() method. Remove non strictly Cover related options
#
# Revision 1.1  2004/04/11 19:36:32  cbouvi
# Started conversion of pscdcover to PostScript::CDCover
#

use vars qw/ $VERSION /;
$VERSION = 1.0;

use File::Basename qw/ dirname /;
use File::Path     qw/ mkpath /;

package PostScript::CDCover::Directory;

# Constructor
# Directory name as optional argument
sub new {

    my $proto = shift;
    my $class = ref($proto) || $proto;

    my $self = bless {}, $class;
    $self->{_name} = $_[0] if @_;
    return $self;
}

sub name {

    my $self = shift;
    ($self->{_name}, @_ && ($self->{_name} = $_[0]))[0];
}

# Returns the PostScript::CDCover::Directory object for a given subdirectory.
# If no argument is given, return $self.
# If the directory object does not exist, it is created.
sub directory {

    my ($self, $name) = @_;

    return $self unless $name;
    return $self->{_directories}{$name} ||= new PostScript::CDCover::Directory $name;
}

# Add a directory, somewhere in the subtree, i.e., if the new directory is more
# than one level below the current one, the actual addition is delegated to a
# first level subdirectory.
sub add_directory {

    my ($self, $path) = @_;

    $path =~ s|^[/\\]||;
    my ($head, $rest) = split m|[/\\]|, $path, 2;
    my $dir = $self->directory($head);
    $dir->add_directory($rest) if $rest;
}

# Add a file somewhere in the subtree. If the file does not belong to the
# current directory, the task of adding it is delegated to a subdirectory
# (which, in turn, can delegate to one of its own subdirectories, and so on).
sub add_file {

    my ($self, $path) = @_;

    $path =~ s|^[/\\]||;
    my ($head, $rest) = split m|[/\\]|, $path, 2;
    if ( $rest ) {
        $self->directory($head)->add_file($rest);
    }
    else {
        push @{$self->{_files}}, $head;
    }
}

# Returns a string consisting of all the calls to the Postscript program
# function file_title or folder_title for the current directory.
# A $depth parameter can optionally be specified for indentation.
# as_ps() will recursively call itself on every subdirectories with an
# incremented $depth, thus generating the output for all the subtree.
sub as_ps {

    my $self = shift;
    # The root has an empty name and is not display. All the subdirectories
    # start at level 0. The root is thus as it were at level -1
    my $depth = @_ ? shift : -1;
    my $indent = '  ' x $depth; # indentation in the Postscript source code

    my $name = PostScript::CDCover::_quote_paren($self->name());
    my @output;

    # A line for the directory itself
    @output = (qq{$indent($name) $depth folder_title}) if $name; 

    # Now for its subdirectories
    for ( sort keys %{$self->{_directories}} ) {
        push @output, $self->{_directories}{$_}->as_ps($depth+1);
    }

    ++$depth;
    # And finally, its files
    if ( $self->{_files} ) {
        for ( sort @{$self->{_files}} ) {
            my $n = PostScript::CDCover::_quote_paren($_);
            push @output, qq{$indent  ($n) $depth file_title};
        }
    }

    return join "\n", @output;
}

package PostScript::CDCover;

# returns the directory where CDCover.pm (this very file) resides.
sub dir {
    (my $module = __PACKAGE__ ) =~ s|::|/|g;
    dirname( $INC{"$module.pm"} )
}

sub new {

    my $proto = shift;
    my $class = ref($proto) || $proto;

    my $self = bless {}, $class;

    my %attr = @_;