The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package App::Followme;

use 5.008005;
use strict;
use warnings;

use lib '..';

use Cwd;
use IO::Dir;
use IO::File;
use Clone qw(clone);
use File::Spec::Functions qw(rel2abs splitdir catfile no_upwards rootdir updir);

use App::Followme::Common qw(exclude_file split_filename top_directory);

our $VERSION = "0.90";

#----------------------------------------------------------------------
# Create a new object to update a website

sub new {
    my ($pkg, $configuration) = @_;

    my $self = bless({}, $pkg);    
    my %parameters = $self->update_parameters($pkg, $configuration);
    $self->{$_} = $parameters{$_} foreach keys %parameters;
    
    return $self;
}

#----------------------------------------------------------------------
# Read the default parameter values

sub parameters {
    my ($pkg) = @_;
    
    return (
            configuration_file => 'followme.cfg',
            exclude_folders => 'templates',
            quick_update => 0,
            );
}

#----------------------------------------------------------------------
# Perform all updates on the directory

sub run {
    my ($self, $filename) = @_;

    my $directory = $self->set_directory($filename);    
    my $configuration = $self->initialize_configuration($directory);
    $self->update_folder($directory, $configuration);

    return;
}

#----------------------------------------------------------------------
# Find the configuration files above a directory

sub find_configuration {
    my ($self, $directory) = @_;

    chdir($directory);
    my $root_dir = rootdir();
    my @configuration_files;

    for (;;) {
        chdir(updir());
        last if getcwd() eq $root_dir;

        push(@configuration_files, rel2abs($self->{configuration_file}))
            if -e $self->{configuration_file};
    }
    
    chdir($directory);
    return reverse @configuration_files;
}

#----------------------------------------------------------------------
# Get the subdirectories in the current folder

sub get_subdirectories {
    my ($self) = @_;
    
    my @subdirectories;    
    my $dd = IO::Dir->new(getcwd());

    while (defined (my $file = $dd->read())) {
        push(@subdirectories, $file) if -d $file;
    }
    
    $dd->close();
    return no_upwards(@subdirectories);
}

#----------------------------------------------------------------------
# Find and read the configuration files

sub initialize_configuration {
    my ($self, $directory) = @_;

    my $top_dir;
    my $configuration = {};
    %$configuration = %$self;
    $configuration->{module} = [];

    foreach my $filename ($self->find_configuration($directory)) {
        my ($dir, $file) = split_filename($filename);
        $top_dir ||= $dir;
        chdir($dir);
        
        $configuration = $self->update_configuration($filename, $configuration);
    }

    $top_dir ||= $directory;
    top_directory($top_dir);
    
    chdir($directory);
    return $configuration;
}

#----------------------------------------------------------------------
# Load a modeule if it has not already been loaded

sub load_modules {
    my ($self, $configuration) = @_;

    foreach (reverse @{$configuration->{module}}) {
        last if ref $_;
        
        my $module = $_;
        eval "require $module" or die "Module not found: $module\n";

        $configuration->{base_directory} = getcwd();
        my %parameters = $self->update_parameters($module, $configuration);
        my $obj = $module->new(\%parameters);

        $_ = $obj;
    }

    return;
}

#----------------------------------------------------------------------
# Set a value in the configuration hash

sub set_configuration {
    my ($self, $configuration, $name, $value) = @_;
    
    if (ref $configuration->{$name} eq 'HASH') {
        $configuration->{$name}{$value} = 1;
        
    } elsif (ref $configuration->{$name} eq 'ARRAY') {
        push(@{$configuration->{$name}}, $value);

    } else {
       $configuration->{$name} = $value;
    }

    return;
}

#----------------------------------------------------------------------
# If name passed is not directory, set a sensible default

sub set_directory {
    my ($self, $filename) = @_;
    
    my ($directory, $file);
    if (defined $filename) {
        if (! -d $filename) {
            ($directory, $file) = split_filename($filename);
            $self->{quick_update} = 1;
        }
        
    } else {
        $directory = getcwd();
    }

    return $directory;
}

#----------------------------------------------------------------------
# Update the configuration from a file

sub update_configuration {
    my ($self, $filename, $configuration) = @_;

    my $fd = IO::File->new($filename, 'r');

    if ($fd) {
        while (my $line = <$fd>) {
            # Ignore comments and blank lines
            next if $line =~ /^\s*\#/ || $line !~ /\S/;

            # Split line into name and value, remove leading and
            # trailing whitespace

            my ($name, $value) = split (/\s*=\s*/, $line, 2);

            die "Bad line in config file: ($name)" unless defined $value;
            $value =~ s/\s+$//;

            # Insert the name and value into the hash

            $self->set_configuration($configuration, $name, $value);
        }

        close($fd);
    }

    $self->load_modules($configuration);
    return $configuration;
}

#----------------------------------------------------------------------
# Update files in one folder

sub update_folder {
    my ($self, $directory, $configuration) = @_;
    
    # Copy the configuration so all changes are local to this sub
    $configuration = clone($configuration);

    # Save the current directory so we can return when finished
    my $current_directory = getcwd();
    chdir($directory);
     
    # Read any configuration found in this directory
    $configuration = $self->update_configuration($self->{configuration_file},
                                                 $configuration)
                     if -e $self->{configuration_file};
    
    # Run the modules mentioned in the configuration
    # Run any that return true on the subdirectories
    
    my @modules;
    foreach my $module (@{$configuration->{module}}) {
        push(@modules, $module) if $module->run();
        chdir($directory);
    }

    # Recurse on the subdirectories running the filtered list of modules
    
    if (@modules) {
        $configuration->{module} = \@modules;
        my @subdirectories = $self->get_subdirectories();
    
        foreach my $subdirectory (@subdirectories) {
            next if exclude_file($self->{exclude_folders}, $subdirectory);
            $self->update_folder($subdirectory, $configuration);
        }
    }

    chdir($current_directory);
    return;
}

#----------------------------------------------------------------------
# Update a module's parameters

sub update_parameters {
    my ($self, $module, $configuration) = @_;
    
    $configuration = {} unless defined $configuration;
    return %$configuration unless $module->can('parameters');
        
    my %parameters = $module->parameters();
    foreach my $field (keys %parameters) {
        $parameters{$field} = $configuration->{$field}
            if exists $configuration->{$field};
    }
    
    return %parameters;
}

1;
__END__

=encoding utf-8

=head1 NAME

App::Followme - Update a static website

=head1 SYNOPSIS

    use App::Followme;
    my $app = App::Followme->new($configuration);
    $app->run(shift @ARGV);

=head1 DESCRIPTION

This is the module that is run by the followme script. It loads and runs
all the other modules. When it is run, it searches the directory path for
configuration files. The topmost file defines the top directory of the website.
It reads each configuration file it finds and then starts updating the directory
passed as an argument to run, or if no directory is passed, the directory the
followme script is run from.

Configuration file lines are organized as lines containing

    NAME = VALUE

and may contain blank lines or comment lines starting with a C<#>. Values in
configuration files are combined with those set in the files in directories
above it.

The module parameter contains the name of a module to be run on the directory
containing the configuration file and possibly its subdirectories. It must have
new and run methods. An object is created by calling the new method with the
configuration. The run method is then called without arguments. The run method
returns a value, which if true indicates that module should be run in the
subdirectories of the current directory.

=head1 LICENSE

Copyright (C) Bernie Simon.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHOR

Bernie Simon E<lt>bernie.simon@gmail.comE<gt>

=cut