The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# @(#)Ident: Templates.pm 2014-01-11 03:08 pjf ;

package CatalystX::Usul::Model::Templates;

use strict;
use version; our $VERSION = qv( sprintf '0.17.%d', q$Rev: 1 $ =~ /\d+/gmx );

use CatalystX::Usul::Moose;
use CatalystX::Usul::Constants;
use CatalystX::Usul::Functions qw( escape_TT unescape_TT io throw );
use Class::Usul::File;
use File::Spec::Functions      qw( catdir );
use TryCatch;

extends q(CatalystX::Usul::Model);
with    q(CatalystX::Usul::TraitFor::Model::StashHelper);
with    q(CatalystX::Usul::TraitFor::Model::QueryingRequest);

has 'blank_ns'     => is => 'ro', isa => NonEmptySimpleStr, default => 'none';

has 'escape_chars' => is => 'ro', isa => ArrayRef[NonEmptySimpleStr],
   default         => sub { [ '{ }' ] };

has 'extension'    => is => 'ro', isa => NonEmptySimpleStr, default => '.tt';

has 'ns_key'       => is => 'ro', isa => NonEmptySimpleStr,
   default         => 'namespace';

has 'root_ns'      => is => 'ro', isa => NonEmptySimpleStr, default => 'root';

has '_file' => is => 'lazy', isa => FileClass,
   default  => sub { Class::Usul::File->new( builder => $_[ 0 ]->usul ) },
   init_arg => undef, reader => 'file';

sub create_or_update {
   my ($self, $ns) = @_;

   my $extn    = $self->extension;
   my $newtag  = $self->context->stash->{newtag};
   my $name    = $self->query_value( q(template) );
   my $content = unescape_TT $self->query_value( q(content) );
   my $message = 'Template [_1] / [_2] updated';

   if ($name eq $newtag) {
      $name    = $self->query_value( q(name) );
      $name and $name !~ m{ $extn \z }mx and $name .= $extn;
      $message = 'Template [_1] / [_2] created';
   }

   $name or throw 'Template name not specified';
   io( [ $self->_get_dir_for( $ns ), $name ] )->print( $content );
   $self->add_result_msg( $message, [ $ns, $name ] );
   return $name;
}

sub delete {
   my ($self, $ns) = @_;

   my $name = $self->query_value( q(template) )
      or throw 'Template name not specified';

   io( [ $self->_get_dir_for( $ns ), $name ] )->unlink;
   $self->add_result_msg( 'Template [_1] / [_2] deleted', [ $ns, $name ] );
   return;
}

sub templates_view_form {
   my ($self, $ns, $name) = @_; my $s = $self->context->stash; my $data = {};

   my $newtag = $s->{newtag}; $ns ||= q(default); $name ||= $newtag;

   try        { $data = $self->_get_template_data( $ns, $name ) }
   catch ($e) { $self->add_error( $e ) }

   my $form     = $s->{form}->{name};
   my $firstfld = $form.($name eq $newtag ? q(.name) : q(.template));
   my $spaces   = [ NUL, $self->blank_ns, $self->root_ns,
                    sort keys %{ $s->{ $self->ns_key } } ];
   my $list     = [ NUL, $newtag, @{ $data->{list} || [] } ];

   $self->clear_form  ( { firstfld => $firstfld } );
   $self->add_field   ( { default  => $ns,
                          id       => $form.q(.namespace),
                          values   => $spaces, } );
   $self->add_field   ( { default  => $name,
                          id       => $form.q(.template),
                          values   => $list, } );

   if ($name ne $newtag) { $self->add_hidden( q(name), $name ) }
   else { $self->add_field( { id => $form.q(.name) } ) }

   $self->group_fields( { id       => $form.q(.select) } );
   $self->add_field   ( { default  => $data->{template} || NUL,
                          id       => $form.q(.content), } );
   $self->group_fields( { id       => $form.q(.edit) } );

   if ($name eq $newtag) { $self->add_buttons( qw(Insert) ) }
   else { $self->add_buttons( qw(Save Delete) ) }

   return;
}

# Private methods

sub _get_dir_for {
   my ($self, $ns) = @_; $ns eq $self->blank_ns and $ns = NUL;

   my $sep = SEP; my $templates = $self->context->config->{template_dir};

   return catdir( $templates, split m{ $sep }mx, $ns );
}

sub _get_template_data {
   my ($self, $ns, $name) = @_;

   my $extn  = $self->extension;
   my $dir   = $self->_get_dir_for( $ns );
   my $io    = io [ $dir, $name ];
   my $tt    = $io->is_file ? $io->all : NUL;
   my $fs    = $self->context->model( q(FileSystem) );
   my $args  = { dir => $dir, pattern => qr{ \Q$extn\E \z }mx };
   my $table = $fs->list_subdirectory( $args );

   return { list     => [ map { $_->{name} } @{ $table->values } ],
            template => escape_TT $tt, $self->escape_chars };
}

__PACKAGE__->meta->make_immutable;

1;

__END__

=pod

=head1 Name

CatalystX::Usul::Model::Templates - Edit page templates

=head1 Version

v0.10.$Rev: 1 $

=head1 Synopsis

   package YourApp;

   use Catalyst qw(ConfigComponents...);

   __PACKAGE__->config( 'Model::Templates' => {
      parent_classes => 'CatalystX::Usul::Model::Templates' } );

=head1 Description

CRUD methods for L<Template::Toolkit> files

=head1 Configuration and Environment

Defines the following list of attributes

=over 3

=item blank_ns

A non-empty simple string which defaults to C<none>. A marker to indicate
an application wide template. One that does not belong to a specific
namespace

=item escape_chars

An array ref of non-empty simple strings. Pair of fencepost characters
used to replace C<[> and C<]> when escaping L<Template::Toolkit> templates

=item extension

A non-empty simple string which defaults to F<.tt>

=item ns_key

A non-empty simple string which defaults to C<namespace>

=item root_ns

A non-empty simple string which defaults to C<root>

=back

=head1 Subroutines/Methods

=head2 build_per_context_instance

Instantiates the query object. Returns a clone of the model object

=head2 create_or_update

   $name = $self->create_or_update( $namespace );

Transforms C<$namespace> into the path to the template directory. Gets the
template from the form. Writes the form content to the selected template
file and returns the template name

=head2 delete

   $c->self->delete( $namespace );

Deletes the template specified by the form parameter and the selected
namespace

=head2 _get_template_data

   $hashref = $self->_get_template_data( $namespace, $name );

Returns a hashref containing a list of template names and the content of
the selected template

=head2 templates_view_form

   $self->templates_view_form( $namespace, $name );

Calls L</_get_template_data> and stash the data used to build the
template editing form

=head1 Diagnostics

None

=head1 Dependencies

=over 3

=item L<CatalystX::Usul::Model>

=item L<CatalystX::Usul::TraitFor::Model::QueryingRequest>

=item L<CatalystX::Usul::TraitFor::Model::StashHelper>

=item L<Class::Usul::File>

=item L<CatalystX::Usul::Moose>

=back

=head1 Incompatibilities

There are no known incompatibilities in this module

=head1 Bugs and Limitations

There are no known bugs in this module.
Please report problems to the address below.
Patches are welcome

=head1 Acknowledgements

Larry Wall - For the Perl programming language

=head1 Author

Peter Flanigan, C<< <Support at RoxSoft.co.uk> >>

=head1 License and Copyright

Copyright (c) 2014 Peter Flanigan. All rights reserved

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. See L<perlartistic>

This program is distributed in the hope that it will be useful,
but WITHOUT WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE

=cut

# Local Variables:
# mode: perl
# tab-width: 3
# End: