view release on metacpan or  search on metacpan

lib/CatalystX/CMS/File.pm  view on Meta::CPAN

package CatalystX::CMS::File;
use strict;
use warnings;
use base qw(
    SVN::Class::File
    Path::Class::File::Lockable
    Class::Accessor::Fast
);
use MRO::Compat;
use mro 'c3';
use Carp;
use Data::Dump qw( dump );

our $VERSION = '0.011';

__PACKAGE__->mk_accessors(qw( attrs content ext has_unsaved_changes ));

=head1 NAME

CatalystX::CMS::File - template file class

=head1 SYNOPSIS

 use CatalystX::CMS::File;

 # longhand
 my $file = CatalystX::CMS::File->new( $path_to_file );
 $file->fetch if $page->size;
 $file->content('hello world');
 $file->title('super foo');
 $file->write;
 $file->commit or die $file->errstr;
 
 # shorthand
 my $file = CatalystX::CMS::File->new(
                        path    => $path_to_file,
                        title   => 'super foo',
                        content => 'hello world',
                        );
 eval { $file->save  } or die $file->errstr;
 print "$file was saved\n";
                        
=head1 DESCRIPTION

CatalystX::CMS::File is the object model for the Template Toolkit files that
make up the content system of your application. 
Each object represents a C<.tt>
file on the filesystem in a Subversion working directory.
An object can be read, written, locked and unlocked on the filesystem.
As a subclass of SVN::Class::File, the object can be interrogated 
for its history, added, deleted, committed or updated.

=head2 new( I<path> )

=head2 new( path => I<path> [, %param ] )

Create a new object.

Either form of new() may be used, but I<path> is always
required.

=cut

sub new {
    my $class = shift;
    my @param = @_;
    my ( $self, %arg );

    if ( !@param ) {
        croak "path required";
    }
    elsif ( @param == 1 ) {
        $self = $class->next::method(@param);
    }
    elsif ( @param % 2 ) {
        croak "new() requires either a path or a hash of key/value pairs";
    }
    elsif ( @param == 2 && $param[0] ne 'path' ) {
        $self = $class->next::method(@param);
    }
    else {
        %arg = @param;
        my $path = delete $arg{path} or croak "path required";
        $self = $class->next::method($path);
    }

    # add other attributes
    $self->{$_} = $arg{$_} for keys %arg;

    $self->{attrs} ||= {};

    # path cleanup
    $self->{ext} ||= '.tt';

    # re-create the object with extension
    my $ext = $self->{ext};
    unless ( $self =~ m/$ext$/ ) {
        $self = $self->new( $self . $self->{ext} );
    }

    #carp dump $self;

    return $self;
}

=head2 read

Reads the file from disk and parses the metadata attributes and content,
thereafter accessible via the attrs() and content() methods.

lib/CatalystX/CMS/File.pm  view on Meta::CPAN

        return 1;
    }
    elsif ( $stat == 0
        && !$self->error )
    {
        return 1;
    }

    return 0;
}

sub _parse_page {
    my ( $self, $buf ) = @_;

    # example:
    #
    #  [% # CMS
    #       cmspage.attrs.title = 'foo'
    #  %]
    #
    #   this is a page.
    #

    $self->_escape( \$buf );

    my ( $attrs, $content )
        = ( $buf =~ m/^\s*\[\%\s+\#\s*CMS\s+(.+?)\%\]\s*(.*)$/s );
    if ( $attrs && $content ) {
        my $depth = 100;
        my $count = 0;
        while ( $attrs =~ m/\bcmspage\.attrs\.(\w+)\s*=\s*(['"])(.+?)\2/sg ) {

            last if $count++ > $depth;

            my $key = $1;
            my $val = $3;

            # reserved words
            next if $key eq 'attrs';
            next if $key eq 'content';
            next if $key eq 'page';

            $self->{attrs}->{$key} = $val;
        }

        $self->content($content);
    }
    else {
        $self->content($buf);
    }
    return $self;
}

=head2 write( [I<ignore_lock>] )

Writes attrs() and content() to file location in TT-compatible format.

Will croak on any error.

If the I<ignore_lock> flag is true, write() will ignore any true
value of locked(). Otherwise, will croak() if locked() is true.

Returns the size of the resulting file.

=cut

sub write {
    my $self = shift;
    my $force = shift || 0;

    if ( $self->locked && !$force ) {
        croak "write failed. $self is locked";
    }

    my $fh = $self->openw();

    # make sure we have at least one newline at end of file.
    my $content = $self->content || '';
    chomp $content;
    $content .= "\n";
    $self->_unescape( \$content );

    print {$fh} join( "\n", $self->_ttify_attrs, $content )
        or croak "write failed for $self: $!";
    $fh->close;

    return -s $self;
}

my $COMMENT      = 'CXCMS COMMENT: DO NOT REMOVE';
my @special_tags = qw( textarea );

sub _escape {
    my ( $self, $buf_ref ) = @_;

    for my $tag (@special_tags) {
        if ( $$buf_ref =~ m!</?$tag!i ) {
            $$buf_ref =~ s,<(/?${tag}.*?)>,<!-- $COMMENT $1 -->,sgi;
        }
    }
}

sub _unescape {
    my ( $self, $buf_ref ) = @_;

    if ( $$buf_ref =~ m!$COMMENT!i ) {
        $$buf_ref =~ s,<!-- $COMMENT (.+?) -->,<$1>,sgi;
    }
}

=head2 create( I<user> )

Acquires lock for I<user> and writes files as a new page.

=cut

sub create {
    my $self = shift;
    my $user = shift or croak "user required";

    # create any required parent directories
    $self->dir->mkpath();

    if ( $self->locked or -s $self ) {
        croak "cannot create $self : locked or already exists";
    }

    $self->lock($user);
    $self->attrs->{owner} = $user;
    $self->content('[ this is a new page ]');
    return $self->write(1);
}

=head2 update

Calls write().

B<NOTE:> This is not the same as the SVN::Class->update method!
If you want that method, use the up() alias instead.

=cut

sub update {
    my $self = shift;
    if ( !-s $self ) {
        croak "cannot update an empty file";
    }
    $self->write(@_);
}

sub _ttify_attrs {
    my $self = shift;

    # make a TT-hash out of a Perl hash
    my $attrs = $self->attrs;
    my $buf   = "[% # CMS\n\n";
    for my $key ( sort keys %$attrs ) {
        $buf .= "    cmspage.attrs.$key = '" . qq($attrs->{$key}) . "';\n";
    }
    return $buf . "\n%]";
}

=head2 save( I<message> [, I<leave_lock>, I<username> ] )

Will write() file, add() to the SVN workspace if necessary,
and then call commit( I<message> ).

Returns -1 if status() of file indicates no modification.
Otherwise, returns commit() return value.

Pass a true for I<leave_lock> to leave the lock file intact
after the commit().

Pass an authorized I<username> to have the commit() made with that
credential.

=cut

sub save {
    my $self       = shift;
    my $message    = shift || '[no log message]';
    my $leave_lock = shift || 0;
    my $username   = shift;

    # pass force flag to write() since we want lock