The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use v5.10;
use Data::Dumper;
use IO::File;
use XML::Flow;
my ( $help, $man, $template, $prefix );
my %opt = (
    help     => \$help,
    man      => \$man,
    template => \$template,
    prefix   => \$prefix
);
GetOptions( \%opt, 'help|?', 'man', "template|t:s", "prefix|p:s" )
  or pod2usage(2);
pod2usage(1) if $help;
pod2usage( -exitstatus => 0, -verbose => 2 ) if $man;

unless ($template) {
    pod2usage( -exitstatus => 2, -message => 'Need -template [file]!' );
}
unless ( -e $template ) {
    pod2usage( -exitstatus => 2, -message => "Not exists template: $template" );
}

{
    my $infile = shift;
    my $in_fd;
    if ($infile) {
        $in_fd = new IO::File:: "< $infile" or die "$infile: $!";
    }
    else {
        $in_fd = \*STDIN;
    }

}

=head2  parse_feed \*STDIN, sub handler {}

=cut

sub parse_feed {
    my ( $data, $sub_ref ) = @_;
    my $rd   = new XML::Flow:: $data;
    my %tags = (
        entry => sub {
            shift;
            if   ($sub_ref) { $sub_ref->(@_) }
            else            { print "Item:" . Dumper( {@_} ) }
        },
        'content' => sub {
            my $attr = shift;
            return content => join "", @_;
        },
        'link' => sub { my $attr = shift; return ( 'link' => $attr ) },
        '*' => sub {
            my ( $name, $attr, @text ) = @_;
            return $name => join "",
              @text;
        },
    );
    $rd->read( \%tags );
    $rd->close;
}

my $source = \*STDIN;
my $i      = 0;
my @nodes  = ();
&parse_feed(
    $source,
    sub {
        my %record = @_;
        push @nodes, \%record;
    }
);

# setup next and previus keys
my $size = reverse @nodes;
for ( my $i = 0 ; $i < $size ; $i++ ) {
    my $n = $nodes[$i];
    $n->{prev} = $nodes[$i] if $i;
    $n->{next} = $nodes[ $i + 1 ] if $i < ( $size - 1 );
}

#call template
foreach my $node (@nodes) {
    my $link = $node->{link}->{href}
      or die "Can't read link's href: id= $node->{id}";

    #split url into path and filename
    #remove http://hostname.com/
    $link =~ s%[^\/]+//[^\/]+/%%;
    my ( $path, $file_name ) = ( '', $link );
    if ( $link =~ /(.+)\/([^\/]+)$/ ) {
        ( $path, $file_name ) = ( $1, $2 );
    }
    my $file_path = ( $prefix || '' ) . "/" . $path;

    #make path
    use File::Path;
    mkpath( $file_path, 0 );
    use Template;
    my $tt = Template->new( { INTERPOLATE => 0, ABSOLUTE => 1 } );

    #process input template, substituting variables
    $tt->process( $template, $node, "$file_path/$file_name" )
      || die $tt->error();

}

#stop

1;

=head1 NAME

  atom2file  - render html files from atom file

=head1 SYNOPSIS

  atom2file -template contrib/template.tmpl < atom.xml
 

   [options]:

    -help  - print help message
    -man   - print man page
    -template file - TT2 template file
    -prefix path - directory path for store files to

=head1 TEMPLATE

Template call with the following keys for each atom entry:

          {
            'published' => '2012-11-27T09:39:19Z',
            'link' => {
                        'rel' => 'alternate',
                        'href' => 'http://example.com/Test-chapter.htm',
                        'type' => 'text/html',
                        'title' => 'Test chapter'
                      },
            'content' => 'HTML text',
            'updated' => '2012-12-17T13:29:08Z',
            'id' => 'http://example.com;Test chapter',
            'title' => 'Test chapter'
            'next' =>{ next atom node},
            'prev' =>{ previus atom node}

          }

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exit

=item B<-man>

Prints manual page and exit

=back

=head1 DESCRIPTION

    atom2file - render html files from atom file 

=head1 EXAMPLE

    atom2file -template contrib/template.tmpl -prefix /tmp < atom.xml

=head1 AUTHOR

Zahatski Aliaksandr, E<lt>zahatski@gmail.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2013 by Zahatski Aliaksandr

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

=cut