Design object Perl

It is a small backend blog engine that uses the file system as a storage. But I have some ideas to improve things a bit, I'll add support for git and another thing. But I'd like to have an opinion in the state, including the design of Common, Articles, Pages, and Comments class. The code is below:

package MahewinBlogEngine::Common;

use feature "state";

use Moo;
use Types::Path::Tiny qw/Path AbsPath/;

use CHI;

use MahewinBlogEngine::Renderer;
use MahewinBlogEngine::Exceptions;

use Type::Params qw( compile );
use Type::Utils;
use Types::Standard qw( slurpy Object Dict Str HashRef ArrayRef );

my $invocant = class_type { class => __PACKAGE__ };

=attr directory

rw, required, Str. The directory contain articles.

=cut

has 'directory' => (
    is       => 'rw',
    isa      => AbsPath,
    required => 1,
    coerce   => AbsPath->coercion,
);

=attr encoding

rw, Str. Indicate the encoding file. Default is utf8. Deprecated in the
next version

=cut

has 'encoding' => (
    is      => 'rw',
    isa     => Str,
    default => 'utf8'
);

=attr date_format

ro, Str. Date format used to display, POSIX strftime.
Default value is %x %T.

=cut

has 'date_format' => (
    is      => 'ro',
    isa     => Str,
    default => "%x %T"
);

has _last_file => (
    is       => 'rw',
    isa      => HashRef,
    default  => sub { {} },
    init_arg => undef,
);

has _renderer => (
    is       => 'lazy',
    isa      => Object,
    init_arg => undef,
);

has _cache => (
    is      => 'lazy',
    isa     => Object,
);

before _get_or_create_cache => sub {
    my ($self, $type) = @_;

    foreach my $file ( $self->directory->children ) {
        if ( exists $self->_last_file->{$file} ) {
            while ( my ( $key, $value ) = each %{ $self->_last_file } ) {
                my $stat = $file->stat;
                if ( $key eq $file ) {
                    if ( $stat->[9] != $value ) {
                        $self->_last_file->{$file} = $stat->[9];
                        $self->_cache->remove($type);
                    }
                }
            }
        }
        else {
            $self->_cache->remove($type);
        }
    }

    return;
};

sub _build__renderer {
    return MahewinBlogEngine::Renderer->new();
}

sub _build__cache {
    return CHI->new( driver => 'Memory', global => 1 );
}

sub _get_or_create_cache {
    my ( $self, $type ) = @_;

    my $cache = $self->_cache->get($type);

    if ( !defined($cache) ) {
        my @data = $self->_inject_article;
        $self->_cache->set( $type, \@data );
        $cache = $self->_cache->get($type);
    }

    return $cache;
}

sub _validate_meta {
    my ($self, @file_content) = @_;

    if (   $file_content[0] !~ m/^Title:\s+\w+/
        || $file_content[1] !~ m/^Tags:(?:\s\w+)/ )
    {
        meta_not_valid error => 'Meta not valid';
    }

    return;
}

sub details {
    state $check = compile(
        $invocant,
        slurpy Dict[
            type => Str,
            link => Str,
        ]
    );
    my ($self, $arg) = $check->(@_);
    my $type         = $arg->{type};
    my $url          = $arg->{link};

    foreach my $data ( @{ $self->_get_or_create_cache($type) } ) {
        return $data if $data->{link} eq $url;
    }

    return;
}

sub by_tag {
    state $check = compile(
        $invocant,
        slurpy Dict[
            type => Str,
            tag  => Str,
        ]
    );
    my ($self, $arg) = $check->(@_);
    my $type         = $arg->{type};
    my $tag          = $arg->{tag};

    my @list;
    foreach my $data ( @{ $self->_get_or_create_cache($type) } ) {
        push( @list, $data ) if grep( /$tag/, @{ $data->{tags} } );
    }

    return \@list;
}

sub search {
    state $check = compile(
        $invocant,
        slurpy Dict[
            type    => Str,
            pattern => Str,
        ]
    );
    my ($self, $arg) = $check->(@_);
    my $type         = $arg->{type};
    my $str          = $arg->{pattern};

   my @results;
   foreach my $data ( @{ $self->_get_or_create_cache($type) } ) {
        if ( $data->{title} =~ /$str/i || $data->{content} =~ /$str/i ) {
            push( @results, $data );
        }
   }

   return \@results;
}

1;

Articles:

package MahewinBlogEngine::Articles;

use strict;
use warnings;

use feature qw( state );

use Moo;
extends 'MahewinBlogEngine::Common';

use POSIX;

use MahewinBlogEngine::Exceptions;
use Time::Local qw(timelocal);

use Type::Params qw( compile );
use Type::Utils;
use Types::Standard qw( slurpy Dict Str );

=attr date_order

rw, Str. Specifies the sort order of items asc or desc.

=cut

has date_order => (
    is      => 'rw',
    isa     => Str,
    default => sub { return 'desc' }
);

my $invocant = class_type { class => __PACKAGE__ };

sub BUILD {
    my ($self) = @_;

    $self->_get_or_create_cache('articles');
    return;
}

sub _inject_article {
    my ($self) = @_;

    my @files = sort { $b cmp $a } $self->directory->children;
    my @articles;

    foreach my $file (@files) {
        filename_not_parseable error => 'Filename not parseable: '
        . "$file->basename "
        unless $file->basename =~ /^
        (\d\d\d\d)          # year
        -(\d\d)             # month
        -(\d\d)             # day
        (?:-(\d\d)-(\d\d))? # optional: hour and minute
        (?:-(\d\d))?        # optional: second
        _(.*)               # url part
        \.([a-z]+)          # extension
        $/ix;

        if ( !exists $self->_last_file->{$file} ) {
            my $stat = $file->stat;
            $self->_last_file->{$file} = $stat->[9];
        }

        #Build date, url part and extension
        my $time      = timelocal( $6 // 0, $5 // 0, $4 // 0, $3, $2 - 1, $1 );
        my $url       = lc($7);
        my $extension = lc($8);

        my @lines =
            $file->lines_utf8({chomp  => 0});
        $self->_validate_meta(@lines);

        my $title = shift(@lines);
        my $tags  = shift(@lines);

        $title =~ s/Title:\s//;
        $tags  =~ s/Tags:\s//;

        my $body;
        foreach my $line (@lines) {
            $body .= $line;
        }

        my $content = $self->_renderer->renderer(
            body   => $body,
            format => $extension
        );
        my @tags = split( ',', $tags );

        push(
            @articles,
            {
                title   => $title,
                tags    => \@tags,
                date    => POSIX::strftime( $self->date_format, gmtime($time) ),
                epoch   => $time,
                content => $content,
                link    => $url
           }
        );
     }

     return @articles;
 }

=method articles_list

  $articles->article_list

Return list of all articles

  input: None
  output: ArrayRef[HashRef]: List of all articles

=cut

sub article_list {
    my ($self) = @_;

    return $self->_sort( $self->_get_or_create_cache('articles') );
}

=method article_details

  $articles->article_details( link => 'foo' );

 Return information of article.

  input: link (Int) : required, link of article
  output: Hashref: Details of article

=cut

sub article_details {
    state $check = compile(
        $invocant,
        slurpy Dict[
            link => Str,
        ]
    );
    my ($self, $arg) = $check->(@_);
    my $url = $arg->{link};

    return $self->SUPER::details(
        link => $url,
        type => 'articles'
    );
}

=method article_by_tag

    $articles->article_by_tag( tag => 'world' );

Return a list of articles filter by tag specified.

    input: tag (Str) : tag of filter
    output: ArrayRef[HashRef]: A list of article mathches by tag

=cut

sub article_by_tag {
    state $check = compile(
        $invocant,
        slurpy Dict[
            tag => Str,
        ]
    );
    my ($self, $arg) = $check->(@_);
    my $tag = $arg->{tag};

    return $self->_sort(
        $self->SUPER::by_tag(
            tag  => $tag,
            type => 'articles',
        )
    );
}

sub search {
    state $check = compile(
        $invocant,
        slurpy Dict[
            pattern => Str,
        ]
    );
    my ($self, $arg) = $check->(@_);
    my $str = $arg->{pattern};

    return $self->_sort(
        $self->SUPER::search(
            pattern => $str,
            type    => 'articles',
        )
    );
}

sub _sort {
    my ( $self, $articles ) = @_;


    my @sort = $self->date_order eq 'desc'
        ? sort { $b->{epoch} <=> $a->{epoch} } @{$articles}
        : sort { $a->{epoch} <=> $b->{epoch} } @{$articles};

    return \@sort;
}

1;

Pages:

package MahewinBlogEngine::Pages;

use strict;
use warnings;

use feature qw( state );

use Moo;
extends 'MahewinBlogEngine::Common';

use MahewinBlogEngine::Exceptions;

use Type::Params qw( compile );
use Type::Utils;
use Types::Standard qw( slurpy Dict Str );


my $invocant = class_type { class => __PACKAGE__ };

sub BUILD {
    my ($self) = @_;

    $self->_get_or_create_cache('pages');
    return;
} 

sub _inject_article {
    my ($self) = @_;

    my @files = sort { $b cmp $a } $self->directory->children;
    my @pages;

    foreach my $file (@files) {
        filename_not_parseable error => 'Filename not parseable: '
        . $file->basename . "\n"
        unless $file->basename =~ /^
        (.*)               # url part
        \.([a-z]+)          # extension
        $/ix;

        if ( !exists $self->_last_file->{$file} ) {
            my $stat = $file->stat;
            $self->_last_file->{$file} = $stat->[9];
        }

        #Build url part and extension
        my $url       = lc($1);
        my $extension = lc($2);

        my @lines =
            $file->lines_utf8({chomp  => 0});
        $self->_validate_meta(@lines);

        my $title = shift(@lines);
        my $tags  = shift(@lines);

        $title =~ s/Title:\s//;
        $tags  =~ s/Tags:\s//;

        my $body;
        foreach my $line (@lines) {
            $body .= $line;
        }

        my $content = $self->_renderer->renderer(
            body   => $body,
            format => $extension
        );
        my @tags = split( ',', $tags );

        push(
            @pages,
            {
                title   => $title,
                tags    => \@tags,
                content => $content,
                link    => $url
            }
        );
    }

    return @pages;
}

=method list

  $pages->list

Return list of all pages.

  input: None
  output: ArrayRef[HashRef]: List of all pages

=cut

sub list {
    my ($self) = @_;

    return $self->_get_or_create_cache('pages');
}

=method details

  $pages->details( link => 'foo' );

Return information of page.

  input: link (Str) : required, link of article
  output: Hashref: Details of page

=cut

sub details {
    state $check = compile(
        $invocant,
        slurpy Dict[
            link => Str,
        ]
    );
    my ($self, $arg) = $check->(@_);
    my $url = $arg->{link};

    return $self->SUPER::details(
        link => $url,
        type => 'pages'
    );
}

=method by_tag

    $pages->by_tag( tag => 'world' );

Return a list of pages filter by tag specified.

    input: tag (Str) : tag of filter
    output: ArrayRef[HashRef]: A list of pages mathches by tag

=cut

sub by_tag {
    state $check = compile(
        $invocant,
        slurpy Dict[
            tag => Str,
        ]
    );
    my ($self, $arg) = $check->(@_);
    my $tag = $arg->{tag};

    return $self->SUPER::by_tag(
        tag  => $tag,
        type => 'pages',
    );
}

sub search {
    state $check = compile(
        $invocant,
        slurpy Dict[
            pattern => Str,
        ]
    );
    my ($self, $arg) = $check->(@_);
    my $str = $arg->{pattern};

    return $self->SUPER::search(
        pattern => $str,
        type    => 'pages',
   );
}

1;

Comments:

package MahewinBlogEngine::Comments;

use feature qw( state );

use Moo;
extends 'MahewinBlogEngine::Common';

use Carp;

use Time::Local qw(timelocal);

use MahewinBlogEngine::Exceptions;
use MahewinBlogEngine::Renderer;

use POSIX qw(strftime);

use Type::Params qw( compile );
use Type::Utils;
use Types::Standard qw( slurpy Dict Str HashRef );

my $invocant = class_type { class => __PACKAGE__ };

before _get_or_create_cache => sub {
    my ($self) = @_;

    my $file;
    my $iter = $self->directory->iterator({ recurse => 1 });
    while ( $file = $iter->() ) {
        if ( exists $self->_last_file->{$file} ) {
            while ( my ( $key, $value ) = each %{ $self->_last_file } ) {
                my $stat = $file->stat;
                if ( $key eq $file ) {
                    if ( $stat->[9] != $value ) {
                        $self->_last_file->{$file} = $stat->[9];
                        $self->_cache->remove('comments');
                    }
                }
            }
        }
        else {
            $self->_cache->remove('comments');
        }
    }

    return;
};

sub BUILD {
    my ($self) = @_;

    $self->_get_or_create_cache;
    return;
}

sub _get_or_create_cache {
    my ($self) = @_;

    my $cache = $self->_cache->get('comments');
    if ( !defined($cache) ) {
        my @comments = $self->_inject_comment;
        $self->_cache->set( 'comments', \@comments );
        $cache = $self->_cache->get('comments');
    }

    return $cache;
}

sub _inject_comment {
    my ($self) = @_;

    my @comments;
    my $file;
    my $iter = $self->directory->iterator({ recurse => 1 });
    while ( $file = $iter->() ) {
        if ( $file->is_file ) {
            filename_not_parseable error => 'Filename not parseable: '
            . "$file->basename "
            unless $file->basename =~ /^
            (\d\d\d\d)          # year
            -(\d\d)             # month
            -(\d\d)             # day
            -(\d\d)             # hour
            -(\d\d)             # minute
            -(\d\d)             # second
            \.([a-z]+)          # extension
            $/ix;

            if ( !exists $self->_last_file->{$file} ) {
                my $stat = $file->stat;
                $self->_last_file->{$file} = $stat->[9];
            }

            my $time      = timelocal( $6, $5, $4, $3, $2 - 1, $1 );
            my $extension = lc($7);
            my @lines     = $file->lines_utf8({chomp  => 0});

            my $author = shift(@lines);
            my $mail   = shift(@lines);
            my $url    = shift(@lines);
            my $hidden = shift(@lines);

            $author =~ s/Name:\s//;
            $mail   =~ s/Mail:\s//;
            $url    =~ s/Url:\s//;
            $hidden =~ s/Hidden:\s//;

            my $body;
            foreach my $line (@lines) {
                $body .= $line;
            }

            $body //= '';

            my $content = $self->_renderer->renderer(
                body   => $body,
                format => $extension
            );

            push(
                @comments,
                {
                    author      => $author,
                    mail        => $mail,
                    epoch       => $time,
                    key         => $author . '_' . $time,
                    url         => $url,
                    hidden      => int($hidden) // 0,
                    url_article => $file->parent->basename,
                    body        => $content,
                }
            );
        }
    }

    return @comments;
}

sub comment_list {
    my ($self) = @_;

    return $self->_get_or_create_cache;
}

sub get_comments_by_article {
    state $check = compile(
        $invocant,
        slurpy Dict[
            id_article => Str,
        ]
    );
    my ($self, $arg) = $check->(@_);
    my $id_article = $arg->{id_article};


    my @comments;

    foreach my $comment ( @{ $self->_get_or_create_cache } ) {
        push( @comments, $comment ) if $comment->{url_article} eq $id_article;
    }

    return \@comments;
}

sub add_comment {
    state $check = compile(
        $invocant,
        slurpy Dict[
            id_article => Str,
            params     => HashRef
        ]
    );
    my ($self, $arg) = $check->(@_);
    my $id_article    = $arg->{id_article};
    my $params = $arg->{params};

    my $now = strftime "%Y-%m-%d-%H-%M-%S", localtime;

    my $directory = $self->directory->stringify . '/' . "$id_article";
    my $filename  = "$id_article/$now.md";
    my $file      = $self->directory->file($filename);

    mkdir($directory) unless -e $directory;

    my $name   = $params->{name} // 'Anonymous';
    my $mail   = $params->{mail} // '';
    my $body   = $params->{body} =~ s/\cM//g // '';
    my $url    = $params->{url}              // '';
    my $hidden = int( $params->{hidden} )    // 1;

    my $encoding = $self->encoding;
    my $fh       = $file->open(">:encoding($encoding)");
    print $fh "Name: $name" . "\n";
    print $fh "Mail: $mail" . "\n";
    print $fh "Url: $url" . "\n";
    print $fh "Hidden: $hidden" . "\n";
    print $fh $params->{body} if $params->{body};

    return;
}

1;

I would also like to have your opinion on which Renderer does not inheritance. I have a structure a hash with key is the format and value as an anonymous function that loads the class is going well and the call, it may not be a good idea, I'm not sure, but I think in this context it is ok:

package MahewinBlogEngine::Renderer;

use feature "state";

use Moo;

use Module::Load;

use MahewinBlogEngine::Exceptions;

use Type::Params qw( compile );
use Type::Utils;
use Types::Standard qw( slurpy Dict Object Str HashRef );

my $invocant = class_type { class => __PACKAGE__ };

has _renderer_avalaible => (
    is       => 'lazy',
    isa      => HashRef,
    init_arg => undef
);

sub _build__renderer_avalaible {
    my $rend = {
       md   => sub {
            load MahewinBlogEngine::Renderer::Markdown;

            my $renderer = MahewinBlogEngine::Renderer::Markdown->new;
            $renderer->renderer(shift);
        },
        html => sub {
            load MahewinBlogEngine::Renderer::HTML;

            my $renderer = MahewinBlogEngine::Renderer::HTML->new();
            $renderer->renderer(shift);
        },
        pod => sub {
            load MahewinBlogEngine::Renderer::POD;

            my $renderer = MahewinBlogEngine::Renderer::POD->new();
            $renderer->renderer(shift);
        },
        textile => sub {
            load MahewinBlogEngine::Renderer::Textile;

            my $renderer = MahewinBlogEngine::Renderer::Textile->new();
            $renderer->renderer(shift);
        },
    };

    return $rend;
};

sub renderer {
    state $check = compile(
        $invocant,
        slurpy Dict[
            body   => Str,
            format => Str,
        ]
    );
    my ($self, $arg) = $check->(@_);
    my $text   = $arg->{body};
    my $format = $arg->{format};

    if ( my $rend = $self->_renderer_avalaible->{$format} ) {
        $text =~ s/^\s*(\S*(?:\s+\S+)*)\s*$/$1/;
        return $rend->($text);
    }
    else {
        throw_format_not_supported error => "No renderer for this format $format ";
    }

    return;
}

1;

The repository of the project is available on github. Here I hope that the code is not too bad.