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

use lib '../..';

use Cwd;
use IO::Dir;
use File::Spec::Functions qw(abs2rel splitdir catfile no_upwards);
use App::Followme::Common qw(compile_template exclude_file make_relative 
                             make_template parse_page read_page set_variables 
                             sort_by_date write_page);

our $VERSION = "0.90";

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

sub new {
    my ($pkg, $configuration) = @_;
    
    my %self = %$configuration; 
    return bless(\%self, $pkg);
}

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

sub parameters {
    my ($pkg) = @_;
    
    return (
            absolute => 0,
            base_directory => '',
            news_file => 'index.html',
            news_index_length => 5,
            web_extension => 'html',
            body_tag => 'content',
            exclude_files => 'index.html',
            news_template => catfile('templates', 'news.htm'),
           );
}

#----------------------------------------------------------------------
# Convert text files into web pages

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

    chdir($self->{base_directory});
    eval {$self->create_news_index()};
    warn "$self->{news_file}: $@" if $@;

    return;
}

#----------------------------------------------------------------------
# Create the index of most recent additions to the news

sub create_news_index {
    my ($self) = @_;

    my $data = $self->recent_news_data();

    my $template = make_template($self->{news_template},
                                 $self->{web_extension});
    
    my $sub = compile_template($template);
    my $page = $sub->($data);

    my $news_file = $self->news_file_name();
    write_page($news_file, $page);

    return;
}

#----------------------------------------------------------------------
# Get the more recently changed files

sub more_recent_files {
    my ($self, $limit) = @_;
    
    my @dated_files;
    my $visitor = visitor_function();
    
    while (defined (my $filename = $visitor->($self->{web_extension}))) {
        next if exclude_file($self->{exclude_files}, $filename);
        
        my @stats = stat($filename);
        if (@dated_files < $limit || $stats[9] > $dated_files[0]->[0]) {
            shift(@dated_files) if @dated_files >= $limit;
            push(@dated_files, [$stats[9], $filename]);
            @dated_files = sort {$a->[0] <=> $b->[0]} @dated_files;
        }
    }
    
    my @recent_files = map {$_->[1]} @dated_files;
    @recent_files = reverse @recent_files if @recent_files > 1;
    return @recent_files;
}

#----------------------------------------------------------------------
# Construct news file name. Name is relative to the base directory

sub news_file_name {
    my ($self) = @_;

    my @dirs = splitdir($self->{base_directory});
    push(@dirs, splitdir($self->{news_file}));
    
    return catfile(@dirs);  
}

#----------------------------------------------------------------------
# Get the data to put in the news index

sub recent_news_data {
    my ($self) = @_;

    my @loop;
    my $limit = $self->{news_index_length};
    my $data = set_variables($self->{news_file}, $self->{web_extension});
    $data->{url} = make_relative($data->{url}, $self->{news_file})
                   unless $self->{absolute};
    
    my @filenames = $self->more_recent_files($limit);

    foreach my $filename (@filenames) {
        my $loopdata = set_variables($filename, $self->{web_extension});
        $loopdata->{url} = make_relative($loopdata->{url}, $self->{news_file})
                           unless $self->{absolute};

        my $page = read_page($filename);
        my $blocks = parse_page($page);

        $loopdata->{body} = $blocks->{$self->{body_tag}};
        push(@loop, $loopdata);
    }

    $data->{loop} = \@loop;
    return $data;
}

#----------------------------------------------------------------------
# Return a closure that returns each file name with a specific extension

sub visitor_function {
    my ($self) = @_;

    my @dirlist;
    my @filelist;
    push(@dirlist, '');

    return sub {
        my ($ext) = @_;
        
        for (;;) {
            my $file = shift(@filelist);
            return $file if defined $file;
        
            return unless @dirlist;
            my $dir = shift(@dirlist);
    
            my $dd = $dir ? IO::Dir->new($dir) : IO::Dir->new(getcwd());
            die "Couldn't open $dir: $!\n" unless $dd;
    
            # Find matching files and directories
            while (defined (my $file = $dd->read())) {
                my $path = $dir ? catfile($dir, $file) : $file;
                
                if (-d $path) {
                    next unless no_upwards($file);
                    push(@dirlist, $path);
                    
                } else {
                    next unless $file =~ /^[^\.]+\.$ext$/;
                    push(@filelist, $path);
                }
            }

            $dd->close;

            @dirlist = sort(@dirlist);
            @filelist = reverse sort_by_date(@filelist);
        }
    };
}

1;
__END__

=encoding utf-8

=head1 NAME

App::Followme::CreateNews - Create an index with the more recent files

=head1 SYNOPSIS

    use App::Followme::CreateNew;
    my $indexer = App::Followme::CreateNews->new($configuration);
    $indexer->run();

=head1 DESCRIPTION

This package creates an index for files in the current directory that contains
the text of the most recently modified files together with links to the files,
It can be used to create a basic weblog. The index is built using a template.
The template has Loop comments that look like

    <!-- loop -->
    <!-- endloop -->

and indicate the section of the template that is repeated for each file
contained in the index. The following variables may be used in the template:

=over 4

=item body

All the text inside the content tags in an page.

=item title

The title of the page is derived from the file name by removing the filename
extension, removing any leading digits,replacing dashes with spaces, and
capitalizing the first character of each word.

=item url

The relative url of an html page. 

=item time fields

The variables calculated from the modification time are: C<weekday, month,>
C<monthnum, day, year, hour24, hour, ampm, minute,> and C<second.>

=back

=head1 CONFIGURATION

The following fields in the configuration file are used:

=over 4

=item absolute

If true, urls in a page will be absolute

=item body_tag

The the name of the tag pair containing the body text.

=item base_directory

The directory containing the configuration file. This directory is searched to
create the index.

=item exclude_files

One or more filenames or patterns to exclude from the index

=item news_file

Name of the news index file to be created, relative to the base directory.

=item news_index_length

The number of pages to include in the index.

=item news_template

The path to the template file, relative to the top directory.

=item web_extension

The extension used for web pages. Pages with this extension are considered for
inclusion in the index.

=back

=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