File Coverage

lib/Templer/Site/New.pm

Criterion	Covered	Total	%
statement	43	45	95.5
branch	13	20	65.0
condition	7	9	77.7
subroutine	5	5	100.0
pod	2	2	100.0
total	70	81	86.4

=head1 NAME

Templer::Site::New - Create a new templer site

=cut

=head1 SYNOPSIS

    use strict;
    use warnings;

    use Templer::Site::New;

    my $site = Templer::Site::New->new();
    $site->create( "/tmp/foo" );

=cut

=head1 DESCRIPTION

This class allows a new C site to be created on-disk.  This
involves creating a new input tree, stub configuration file, etc.

The content of the new site, and the directory names, are taken from
the DATA section of this class.

=cut

=head1 LICENSE

This module is free software; you can redistribute it and/or modify it
under the terms of either:

a) the GNU General Public License as published by the Free Software
Foundation; either version 2, or (at your option) any later version,
or

b) the Perl "Artistic License".

=cut

=head1 AUTHOR

Steve Kemp

=cut

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2012-2015 Steve Kemp .

This library is free software. You can modify and or distribute it under
the same terms as Perl itself.

=cut

=head1 METHODS

=cut



use strict;
use warnings;


package Templer::Site::New;

use File::Path qw(mkpath);


=head2 new

The constructor.  No arguments are required/recognized.

=cut

sub new
{
    my $class = shift;
    bless {}, $class;
}


=head2 create

Create a new site in the given directory.

This method parses and processes the DATA section of this very module,
to know which files/directories to create.

=cut

sub create
{
    my ( $self, $base, $force ) = (@_);

    #
    #  Forced defaults to false, if not specified.
    #
    $force = 0 if ( !defined($force) );


    #
    #  Files we created
    #
    my $created = 0;

    my $name   = undef;
    my $marker = undef;
    my $tmp    = undef;

    #
    # Process our data-section.
    #
    while ( my $line =  )
    {
        chomp($line);

        #
        #  Making a directory?
        #
        if ( $line =~ /^mkdir(.*)/ )
        {
            my $dir = $1;
            $dir =~ s/^\s+|\s+$//g;
            $dir = $base . "/" . $dir;

            if ( !-d $dir )
            {
                File::Path::mkpath( $dir, { verbose => 0 } );
            }

        }
        elsif ( !$name &&
                !$marker &&
                ( $line =~ /file\s+([^\s]+)\s+([^\s]+)/ ) )
        {

            #
            #  Writing to a file?
            #
            $name   = $1;
            $marker = $2;
            $tmp    = undef;

        }
        else
        {

            #
            #  If we have a filename to write to, then append to the temporary
            # contents - unless we've found the EOF marker.
            #
            if ( $name && $marker )
            {
                if ( $line eq $marker )
                {
                    my $create = 1;
                    if ( -e $base . "/" . $name )
                    {
                        $create = 0 unless ($force);
                    }

                    if ($create)
                    {
                        my $dst = $base . "/" . $name;

                        open my $handle, ">:utf8", $dst or
                          die "Failed to write to '$dst' - $!";
                        print $handle $tmp;
                        close($handle);

                        $created += 1;
                    }
                    else
                    {
                        print "WARNING: Refusing to over-write $base/$name\n";
                    }

                    $name   = undef;
                    $marker = undef;
                    $tmp    = undef;
                }
                else
                {
                    $tmp .= $line . "\n";
                }
            }
        }

    }
    $created;
}


1;


__DATA__