CatalystX::CMS::Page - content storage class

 my $page = $c->model('CMS')->fetch(file => 'foo/bar');
 # $page isa CatalystX::CMS::Page

package CatalystX::CMS::Page;
use strict;
use warnings;
use base qw( CatalystX::CRUD::Object );
use Carp;
use Data::Dump qw( dump );
use CatalystX::CMS::File;
use MRO::Compat;
use mro 'c3';

use overload(
    q[""]    => sub { shift->delegate },
    fallback => 1,
);

our $VERSION = '0.010';

__PACKAGE__->mk_accessors(qw( cms_root file copy url has_unsaved_changes ));
__PACKAGE__->delegate_class('CatalystX::CMS::File');

sub new {
    my $class = shift;
    my $self  = $class->next::method(@_);
    my $file  = $self->{file} or $self->throw_error("file param required");
    $self->{delegate} ||= $self->delegate_class->new( path => $file );
    return $self;
}

sub create { shift->{delegate}->create(@_) }

sub read { shift->{delegate}->read(@_) }

sub update { shift->{delegate}->update(@_) }

sub delete { shift->{delegate}->delete(@_) }

sub calc_url {
    my $self = shift;
    my $file = $self->file;
    my $type = $self->type;
    my $flav = $self->flavour;
    my $ext  = $self->delegate->ext;
    $file =~ s!^$type[\/\\]!!;
    $file =~ s!^$flav[\/\\]!!;
    $file =~ s!\Q$ext\E$!!;
    $self->url($file);
    return $file;
}

sub title {
    shift->attrs->{title};
}

sub type {
    $_[0]->attrs->{type} || $_[0]->{type};
}

sub flavour {
    $_[0]->attrs->{flavour} || $_[0]->{flavour};
}

sub _parent_dir {
    my $self = shift;
    my $file = shift or croak 'file required';
    my $dir  = $file->parent;
    return $dir->relative( $dir->parent );
}

sub bare_file {
    my $self = shift;
    my $file = $self->delegate->file->basename;
    my $ext  = $self->delegate->ext;
    $file =~ s/\Q$ext\E$//;
    return $file;
}

sub tree {
    my $self = shift;

    #carp dump $self;

    my $file  = $self->delegate;
    my $class = $self->delegate_class;

    # for any given page, we can't easily discover
    # which other pages might be INCLUDEing it,
    # so don't even try. Maybe make that a different
    # feature.
    # instead, just include the wrappers/* files
    # along with the current $file and its immediate
    # descendents.

    my @tree;

    for my $t (qw( wrapper header footer body )) {
        next if $self->url eq $t;
        my %item = (
            url     => $t,
            text    => $t,
            type    => $self->type,
            flavour => $self->flavour,
        );
        push( @tree, \%item );
    }

    my $children = $self->_parse_tt_includes( $file->content );

    my @subtree;
    for my $f (@$children) {

        # TODO better way to get type and flavour
        # for $f. could be an attr in the file,
        # could be determined from path, etc.
        # for now, we just assume the parent's attrs
        my $type    = $self->type;
        my $flavour = $self->flavour;
        my %item    = (
            url     => $f,
            text    => $f,
            type    => $type,
            flavour => $flavour,
        );
        push( @subtree, \%item );
    }

    push( @tree,
        { url => $self->url, text => $self->url, tree => \@subtree } );

    return \@tree;
}

sub _parse_tt_includes {
    my $self = shift;
    my $buf  = shift;
    my $ext  = $self->ext;
    my @files;
    my $depth = 100;
    my $count = 0;
    while ( $buf =~ m/(PROCESS|INCLUDE|INSERT) (\S+)/g ) {
        last if $count++ > $depth;
        my $f = $2;
        unless ( $buf =~ m/BLOCK\ +$f/ ) {
            $f =~ s/$ext$//;
            $f =~ s/\s*;$//;
            next if $f =~ m/[\$'"]/;
            push( @files, $f );
        }
    }
    return \@files;
}

1;

__END__