# DirWalk - Generic processing of directory structure
#
# (c) 2006-12-19, Martin Matousek
# Last change: $Date$
#              $Revision$

package DirWalk;

use lib substr( $INC{'DirWalk.pm'}, 0, -3 );
use strict;
use warnings;

my $opt_start = 
    "The options and paths are interpreted immediately as they come,\n" .
    "so the order is important.";

my $opt_end = 
"    -h              - print the short usage message and exit\n" .
"    --help          - print the full help message and exit. If a profile\n" .
"                      is loaded, it's help is printed additionally.";

# Heritable package must define:
#   $tx = Name()
#   $tx = MessageUsage( $this, $synopsis )
#   $tx = MessagHelp( $this, $opt_start, $opt_end )
#   $tx = MessageVersion()
#
#   $profile = ProfileLoad( $name )  .. optional
#
#   OneItem( $subprofile, $opt, $srcpath, $dst_dir, $dir, $file );
#   1/0 = FileMatch( $this, $dir, $file );
#
# Heritable package can redefine:
#   1/0 = DirMatch( $this, $dir, $file );

sub MessageVersion { ', DirWalk 1.0 ($Revision$)' . "\n"; }

# ------------------------------------------------------------------------------
# commandline parsing, main loop over paths

sub MainLoop {
    my ( $this, $ARGV, $profile, $opt ) = @_;

    my $opt_parse = 1;            # arguments with '-' are treated as options
    my $dst;                      # destination directory 
    my $some_work = 0;            # if at least one source is given
    $opt or $opt = {};

    my $synopsis = "";
    $this->can( 'ProfileLoad' ) and $synopsis .= " -profile=<xxx>";
    $opt->{'nodst'} or $synopsis .= " -outdir=<xxx>";
    $opt->{'noopt'} or $synopsis .= " -opt:key=val";

    $this->can( 'ProfileLoad' ) and $opt_start .= 
        "\n    -profile=<xxx>  - load a profile";
    $opt->{'nodst'} or $opt_start .= 
        "\n    -outdir=<dir>   - put the results into the required directory";
    $opt->{'noopt'} or $opt_start .= 
        "\n    -opt:key=val    - option for use in particular profile";


  
    foreach my $arg ( @{$ARGV} ) {
        if( $opt_parse ) {
            $arg eq '--' and do { $opt_parse = 0;  next; }; # end of options

            # load profile (check is in loader)
            $arg =~ /^-profile=(.*)$/ and do {
                if( $this->can( 'ProfileLoad' ) ) {
                    print "Loading profile '$1'.\n";
                    $profile = $this->ProfileLoad( $1 );
                } else {
                    die "The " . $this->Name() . 
                        " does not use profile loading.\n";
                }
                next;
            };

            # destination directory
            $arg =~ /^-outdir=(.*)$/ and ! $opt->{'nodst'} and 
                do { $dst = $1; next };
        
            # options for loaded profile
            $arg =~ /^-opt:(\w+)=(.*)$/ and do {
                $profile or do {
                    $this->can( 'ProfileLoad' ) and 
                        die "A profile must be loaded before the " .
                        "use of '-opt:key=val'.\n";
                    die "The " . $this->Name() . 
                        " does not use options.\n";
                };

                exists( $profile->{'opt'}{$1} ) or die 
                    "No option '$1' for the loaded profile.\n";
                $profile->{'opt'}{$1} = $2;
                next;
            };

            # help message
            $arg eq '-h' and do {
                print $this->MessageUsage( $synopsis ); exit; };
            $arg eq '--help' and do { 
                print $this->MessageHelp( $opt_start, $opt_end ); 
                $profile and $profile->{'help'} and do {
                    print "\n";
                    print $profile->{'help'};
                };
                print "\n";
                exit;
            };
            $arg =~ /^-(v|-version)$/ and do { 
                print $this->MessageVersion(); 
                print MessageVersion(); 
                exit; 
            };

            # wrong argument
            $arg =~ /^-/ and die "Wrong argument '$arg'.\n" .
                "Try '". $this->Name() . " -h' or '" . 
                $this->Name() . " --help'.\n";
        }

        $profile or die "Profile (-profile=<xxx>) must be loaded " .
            "before the source path.\n";
        $dst or $opt->{'nodst'} or die 
            "Output directory (-outdir=<xxx>) must be defined " .
            "before the source path.\n";
        
        $profile->{'prepare'} and do {
            foreach my $p ( @{$profile->{'sub'}} ) {
                $profile->{'prepare'}( $p, $profile->{'opt'} );
            }
        };

        $arg or die "Wrong source path.\n";
        $arg =~ /\/$/ or $arg .= '/'; # ending slash 

        print "Src: $arg\n";
        defined( $dst ) and print "Dst: $dst\n";
        
        $this->walk_dir( $opt, $profile, $arg, $dst );
        $some_work = 1;
    }

    $some_work or die "Nothing to do.\n" .
        "Try '". $this->Name() . " -h' or '" . 
        $this->Name() . " --help'.\n";

}

# ------------------------------------------------------------------------------
# Recursively process the directory content

sub walk_dir {
    my ($this, $opt, $profile, $src_base, $dst_dir, $src_item, $depth) = @_;

    my $verbose = !$opt->{'quiet'};

    exists( $profile->{'sub'} ) or die "Profile does not have 'sub' defined.";

    $src_item or $src_item = '';
    $depth or $depth = 0;
    my $src = $src_base . $src_item;

    # print "Walk dir: $src\n";

    local *DH;

    opendir DH, $src or die "Cannot open directory '$src'.\n";
    my @entries = readdir DH;
    close DH;

    @entries = sort( @entries );

    foreach my $srcf ( @entries ) {
        ( $srcf eq '.' or $srcf eq '..' ) and next;

        -d "$src$srcf" and do {
            $this->DirMatch( $src_base . $src_item, $srcf ) or next;
            $verbose and print '  ' x $depth, "> $srcf\n";

            if( $this->can( 'PreDir' ) ) {
                foreach my $p ( @{$profile->{'sub'}} ) {
                    $this->PreDir( $p, $profile->{'opt'}, 
                                   $src_base . $src_item . $srcf,
                                   $dst_dir, $src_item );
                }
            }

            $this->walk_dir( $opt, $profile, $src_base, $dst_dir,
                             $src_item . $srcf . "/", $depth + 1 );

            if( $this->can( 'PostDir' ) ) {
                foreach my $p ( @{$profile->{'sub'}} ) {
                    $this->PostDir( $p, $profile->{'opt'}, 
                                    $src_base . $src_item . $srcf,
                                    $dst_dir, $src_item );
                }
            }

            next;
        };
        
        $this->FileMatch( $src_base . $src_item, $srcf ) or next;
        $verbose and print '  ' x $depth, "  $srcf\n";

        my $f = $srcf;
        $f =~ s/\.[^\.]+$//;  # ext

        foreach my $p ( @{$profile->{'sub'}} ) {
            $this->OneItem( $p, $profile->{'opt'}, 
                            $src_base . $src_item . $srcf,
                            $dst_dir, $src_item, $f );
        };
    }
    
}

sub DirMatch {
    1;
}

1;
