package HTML::Latemp::GenMakeHelpers;

use strict;
use warnings;

use vars qw($VERSION);

$VERSION = '0.3.0';

package HTML::Latemp::GenMakeHelpers::Base;

use base 'Class::Accessor';

sub new
{
    my $class = shift;
    my $self = {};
    bless $self, $class;
    $self->initialize(@_);
    return $self;
}

package HTML::Latemp::GenMakeHelpers::HostEntry;

use vars qw(@ISA);

@ISA=(qw(HTML::Latemp::GenMakeHelpers::Base));

__PACKAGE__->mk_accessors(qw(id dest_dir source_dir));

sub initialize
{
    my $self = shift;
    my %args = (@_);

    $self->id($args{'id'});
    $self->source_dir($args{'source_dir'});
    $self->dest_dir($args{'dest_dir'});
}

package HTML::Latemp::GenMakeHelpers::Error;

use vars qw(@ISA);

@ISA=(qw(HTML::Latemp::GenMakeHelpers::Base));

package HTML::Latemp::GenMakeHelpers::Error::UncategorizedFile;

use vars qw(@ISA);

@ISA=(qw(HTML::Latemp::GenMakeHelpers::Error));

__PACKAGE__->mk_accessors(qw(
    file
    host
));

sub initialize
{
    my $self = shift;
    my $args = shift;

    $self->file($args->{'file'});
    $self->host($args->{'host'});

    return 0;
}

package HTML::Latemp::GenMakeHelpers;

=head1 NAME

HTML::Latemp::GenMakeHelpers - A Latemp Utility Module.

=head1 SYNOPSIS

    use HTML::Latemp::GenMakeHelpers;

    my $generator =
        HTML::Latemp::GenMakeHelpers->new(
            'hosts' =>
            [ map {
                +{ 'id' => $_, 'source_dir' => $_,
                    'dest_dir' => "\$(ALL_DEST_BASE)/$_-homepage"
                }
            } (qw(common t2 vipe)) ],
        );

    $generator->process_all();

=head1 API METHODS

=head2 my $generator = HTML::Latemp::GenMakeHelpers->new('hosts => [@hosts])

Construct an object with the host defined in @hosts.

=head2 $generator->process_all()

Process all hosts.

=head1 INTERNAL METHODS
=cut


use vars qw(@ISA);

@ISA=(qw(HTML::Latemp::GenMakeHelpers::Base));

use File::Find::Rule;
use File::Basename;

__PACKAGE__->mk_accessors(qw(base_dir _common_buckets hosts hosts_id_map));

=head2 initialize()

Called by the constructor to initialize the object. Can be sub-classes by
derived classes.

=cut

sub initialize
{
    my $self = shift;
    my (%args) = (@_);

    $self->base_dir("src");
    $self->hosts(
        [
        map {
            HTML::Latemp::GenMakeHelpers::HostEntry->new(
                %$_
            ),
        }
        @{$args{'hosts'}}
        ]
        );
    $self->hosts_id_map(+{ map { $_->{'id'} => $_ } @{$self->hosts()}});
    $self->_common_buckets({});

    return;
}

sub process_all
{
    my $self = shift;
    my $dir = $self->base_dir();

    my @hosts = @{$self->hosts()};

    open my $file_lists_fh, ">", "include.mak";
    open my $rules_fh, ">", "rules.mak";

    print {$rules_fh} "COMMON_SRC_DIR = " . $self->hosts_id_map()->{'common'}->{'source_dir'} . "\n\n";

    foreach my $host (@hosts)
    {
        my $host_outputs = $self->process_host($host);
        print {$file_lists_fh} $host_outputs->{'file_lists'};
        print {$rules_fh} $host_outputs->{'rules'};
    }

    print {$rules_fh} "latemp_targets: " . join(" ", map { '$('.uc($_->{'id'})."_TARGETS)" } grep { $_->{'id'} ne "common" } @hosts) . "\n\n";

    close($rules_fh);
    close($file_lists_fh);
}

sub _make_path
{
    my $self = shift;

    my $host = shift;
    my $path = shift;

    return $host->source_dir(). "/".$path;
}


=head2 $generator->get_initial_buckets($host)

Get the initial buckets for the host $host.

=cut

sub get_initial_buckets
{
    my $self = shift;
    my $host = shift;

    return
    [
        {
            'name' => "IMAGES",
            'filter' =>
            sub
            {
                my $file = shift;
                return ($file !~ /\.(?:tt|w)ml$/) && (-f $self->_make_path($host, $file))
            },
        },
        {
            'name' => "DIRS",
            'filter' =>
            sub
            {
                my $file = shift;
                return (-d $self->_make_path($host, $file))
            },
            filter_out_common => 1,
        },
        {
            'name' => "DOCS",
            'filter' =>
            sub
            {
                my $file = shift;
                return $file =~ /\.x?html\.wml$/;
            },
            'map' => sub { my $a = shift; $a =~ s{\.wml$}{}; return $a;},
        },
        {
            'name' => "TTMLS",
            'filter' =>
            sub
            {
                my $file = shift;
                return $file =~ /\.ttml$/;
            },
            'map' => sub { my $a = shift; $a =~ s{\.ttml$}{}; return $a;},
        },
    ];
}

sub _identity
{
    return shift;
}

sub _process_bucket
{
    my ($self, $bucket) = @_;
    return
        {
            %$bucket,
            'results' => [],
            (
                (!exists($bucket->{'map'})) ?
                    ('map' => \&_identity) :
                    ()
            ),
        };
}

=head2 $generator->get_buckets($host)

Get the processed buckets.

=cut

sub get_buckets
{
    my ($self, $host) = @_;

    return
        [
            map
            { $self->_process_bucket($_) }
            @{$self->get_initial_buckets($host)}
        ];
}

sub _filter_out_special_files
{
    my ($self, $host, $files_ref) = @_;

    my @files = @$files_ref;

    @files = (grep { ! m{(^|/)\.svn(/|$)} } @files);
    @files = (grep { ! /~$/ } @files);
    @files =
        (grep
        {
            my $b = basename($_);
            !(($b =~ /^\./) && ($b =~ /\.swp$/))
        }
        @files
        );

    return \@files;
}

sub _sort_files
{
    my ($self, $host, $files_ref) = @_;

    return [ sort { $a cmp $b } @$files_ref ];
}

=head2 $self->get_non_bucketed_files($host)

Get the files that were not placed in any bucket.

=cut

sub get_non_bucketed_files
{
    my ($self, $host) = @_;

    my $source_dir_path = $host->source_dir();

    my $files = [ File::Find::Rule->in($source_dir_path) ];

    s!^$source_dir_path/!! for @$files;
    $files = [grep { $_ ne $source_dir_path } @$files];

    $files = $self->_filter_out_special_files($host, $files);

    return $self->_sort_files($host, $files);
}

=head2 $self->place_files_into_buckets($host, $files, $buckets)

Sort the files into the buckets.

=cut

sub place_files_into_buckets
{
    my ($self, $host, $files, $buckets) = @_;

    FILE_LOOP:
    foreach my $f (@$files)
    {
        foreach my $b (@$buckets)
        {
            if ($b->{'filter'}->($f))
            {
                if ($host->{'id'} eq "common")
                {
                    $self->_common_buckets->{$b->{name}}->{$f} = 1;
                }

                if (   ($host->{'id'} eq "common")
                    ||
                    (!(
                        $b->{'filter_out_common'}
                            &&
                        exists($self->_common_buckets->{$b->{name}}->{$f})
                    ))
                )
                {
                    push @{$b->{'results'}}, $b->{'map'}->($f);
                }

                next FILE_LOOP;
            }
        }
        die HTML::Latemp::GenMakeHelpers::Error::UncategorizedFile->new(
            {
                'file' => $f,
                'host' => $host->id(),
            }
        );
    }
}

=head2 $self->get_rules_template($host)

Get the makefile rules template for the host $host.

=cut

sub get_rules_template
{
    my ($self, $host) = @_;

    my $h_dest_star = "\$(X8X_DEST)/%";
    my $wml_path = qq{WML_LATEMP_PATH="\$\$(perl -MFile::Spec -e 'print File::Spec->rel2abs(shift)' '\$\@')"};
    my $dest_dir = $host->dest_dir();
    my $source_dir_path = $host->source_dir();

    return <<"EOF";

X8X_SRC_DIR = $source_dir_path

X8X_DEST = $dest_dir

X8X_TARGETS = \$(X8X_DEST) \$(X8X_DIRS_DEST) \$(X8X_COMMON_DIRS_DEST) \$(X8X_COMMON_IMAGES_DEST) \$(X8X_COMMON_DOCS_DEST) \$(X8X_COMMON_TTMLS_DEST) \$(X8X_IMAGES_DEST) \$(X8X_DOCS_DEST) \$(X8X_TTMLS_DEST)

X8X_WML_FLAGS = \$(WML_FLAGS) -DLATEMP_SERVER=x8x

X8X_TTML_FLAGS = \$(TTML_FLAGS) -DLATEMP_SERVER=x8x

X8X_DOCS_DEST = \$(patsubst %,\$(X8X_DEST)/%,\$(X8X_DOCS))

X8X_DIRS_DEST = \$(patsubst %,\$(X8X_DEST)/%,\$(X8X_DIRS))

X8X_IMAGES_DEST = \$(patsubst %,\$(X8X_DEST)/%,\$(X8X_IMAGES))

X8X_TTMLS_DEST = \$(patsubst %,\$(X8X_DEST)/%,\$(X8X_TTMLS))

X8X_COMMON_IMAGES_DEST = \$(patsubst %,\$(X8X_DEST)/%,\$(COMMON_IMAGES))

X8X_COMMON_DIRS_DEST = \$(patsubst %,\$(X8X_DEST)/%,\$(COMMON_DIRS))

X8X_COMMON_TTMLS_DEST = \$(patsubst %,\$(X8X_DEST)/%,\$(COMMON_TTMLS))

X8X_COMMON_DOCS_DEST = \$(patsubst %,\$(X8X_DEST)/%,\$(COMMON_DOCS))

\$(X8X_DOCS_DEST) : $h_dest_star : \$(X8X_SRC_DIR)/%.wml \$(DOCS_COMMON_DEPS)
	 $wml_path ; ( cd \$(X8X_SRC_DIR) && wml -o "\$\${WML_LATEMP_PATH}" \$(X8X_WML_FLAGS) -DLATEMP_FILENAME=\$(patsubst $h_dest_star,%,\$(patsubst %.wml,%,\$@)) \$(patsubst \$(X8X_SRC_DIR)/%,%,\$<) )

\$(X8X_TTMLS_DEST) : $h_dest_star : \$(X8X_SRC_DIR)/%.ttml \$(TTMLS_COMMON_DEPS)
	ttml -o \$@ \$(X8X_TTML_FLAGS) -DLATEMP_FILENAME=\$(patsubst $h_dest_star,%,\$(patsubst %.ttml,%,\$@)) \$<

\$(X8X_DIRS_DEST) : $h_dest_star : unchanged
	mkdir -p \$@
	touch \$@

\$(X8X_IMAGES_DEST) : $h_dest_star : \$(X8X_SRC_DIR)/%
	cp -f \$< \$@

\$(X8X_COMMON_IMAGES_DEST) : $h_dest_star : \$(COMMON_SRC_DIR)/%
	cp -f \$< \$@

\$(X8X_COMMON_TTMLS_DEST) : $h_dest_star : \$(COMMON_SRC_DIR)/%.ttml \$(TTMLS_COMMON_DEPS)
	ttml -o \$@ \$(X8X_TTML_FLAGS) -DLATEMP_FILENAME=\$(patsubst $h_dest_star,%,\$(patsubst %.ttml,%,\$@)) \$<

\$(X8X_COMMON_DOCS_DEST) : $h_dest_star : \$(COMMON_SRC_DIR)/%.wml \$(DOCS_COMMON_DEPS)
	$wml_path ; ( cd \$(COMMON_SRC_DIR) && wml -o "\$\${WML_LATEMP_PATH}" \$(X8X_WML_FLAGS) -DLATEMP_FILENAME=\$(patsubst $h_dest_star,%,\$(patsubst %.wml,%,\$@)) \$(patsubst \$(COMMON_SRC_DIR)/%,%,\$<) )

\$(X8X_COMMON_DIRS_DEST)  : $h_dest_star : unchanged
	mkdir -p \$@
	touch \$@

\$(X8X_DEST): unchanged
	mkdir -p \$@
	touch \$@

EOF
}

=head2 $self->process_host($host)

Process the host $host.

=cut

sub process_host
{
    my $self = shift;
    my $host = shift;

    my $dir = $self->base_dir();

    my $source_dir_path = $host->source_dir();

    my $file_lists_text = "";
    my $rules_text = "";

    my $files = $self->get_non_bucketed_files($host);

    my $buckets = $self->get_buckets($host);

    $self->place_files_into_buckets($host, $files, $buckets);

    my $host_uc = uc($host->id());
    foreach my $b (@$buckets)
    {
        $file_lists_text .= $host_uc . "_" . $b->{'name'} . " =" . join("", map { " $_" } @{$b->{'results'}}) . "\n";
    }

    if ($host->id() ne "common")
    {
        my $rules = $self->get_rules_template($host);

        $rules =~ s!X8X!$host_uc!g;
        $rules =~ s!x8x!$host->id()!ge;
        $rules_text .= $rules;
    }

    return
        {
            'file_lists' => $file_lists_text,
            'rules' => $rules_text,
        };
}

1;

__END__

=head1 AUTHOR

Shlomi Fish, C<< <shlomif@iglu.org.il> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-html-latemp-genmakehelpers@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=HTML-Latemp-GenMakeHelpers>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 ACKNOWLEDGEMENTS

=head1 COPYRIGHT & LICENSE

Copyright 2005 Shlomi Fish, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the MIT X11 License.

=cut