File Coverage

blib/lib/Yancy/Backend/Static.pm

Criterion	Covered	Total	%
statement	145	160	90.6
branch	47	64	73.4
condition	25	33	75.7
subroutine	22	22	100.0
pod	1	7	14.2
total	240	286	83.9

package Yancy::Backend::Static;
our $VERSION = '0.015';
# ABSTRACT: Build a Yancy site from static Markdown files

#pod =head1 SYNOPSIS
#pod
#pod     use Mojolicious::Lite;
#pod     plugin Yancy => {
#pod         backend => 'static:.',
#pod         read_schema => 1,
#pod     };
#pod     get '/*slug', {
#pod         controller => 'yancy',
#pod         action => 'get',
#pod         schema => 'pages',
#pod         slug => 'index', # Default to index page
#pod         template => 'default', # default.html.ep below
#pod     };
#pod     app->start;
#pod     __DATA__
#pod     @@ default.html.ep
#pod     % title $item->{title};
#pod     <%== $item->{html} %>
#pod
#pod =head1 DESCRIPTION
#pod
#pod This L allows Yancy to work with a site made up of
#pod Markdown files with YAML frontmatter, like a L site. In other
#pod words, this module works with a flat-file database made up of YAML
#pod + Markdown files.
#pod
#pod =head2 Schemas
#pod
#pod You should configure the C schema to have all of the fields
#pod that could be in the frontmatter of your Markdown files. This is JSON Schema
#pod and will be validated, but if you're using the Yancy editor, make sure only
#pod to use L.
#pod
#pod =head2 Limitations
#pod
#pod This backend should support everything L supports, though
#pod some list() queries may not work (please make a pull request).
#pod
#pod =head2 Future Developments
#pod
#pod This backend could be enhanced to provide schema for static files
#pod (CSS, JavaScript, etc...) and templates.
#pod
#pod =head1 GETTING STARTED
#pod
#pod To get started using this backend to make a simple static website, first
#pod create a file called C with the following contents:
#pod
#pod     #!/usr/bin/env perl
#pod     use Mojolicious::Lite;
#pod     plugin Yancy => {
#pod         backend => 'static:.',
#pod         read_schema => 1,
#pod     };
#pod     get '/*slug', {
#pod         controller => 'yancy',
#pod         action => 'get',
#pod         schema => 'pages',
#pod         template => 'default',
#pod         layout => 'default',
#pod         slug => 'index',
#pod     };
#pod     app->start;
#pod     __DATA__
#pod     @@ default.html.ep
#pod     % title $item->{title};
#pod     <%== $item->{html} %>
#pod     @@ layouts/default.html.ep
#pod
#pod
#pod
#pod         <%= title %>
#pod
#pod
#pod
#pod
#pod             %= content
#pod
#pod
#pod
#pod
#pod
#pod
#pod Once this is done, run the development webserver using C
#pod daemon>:
#pod
#pod     $ perl myapp.pl daemon
#pod     Server available at http://127.0.0.1:3000
#pod
#pod Then open C in your web browser to see the
#pod L editor.
#pod
#pod =for html
#pod
#pod You should first create an C page by clicking the "Add Item"
#pod button to create a new page and giving the page a C of C.
#pod
#pod =for html
#pod
#pod Once this page is created, you can visit your new page either by
#pod clicking the "eye" icon on the left side of the table, or by navigating
#pod to L.
#pod
#pod =for html
#pod
#pod =head2 Adding Images and Files
#pod
#pod To add other files to your site (images, scripts, stylesheets, etc...),
#pod create a directory called C and put your file in there.  All the
#pod files in the C folder are available to use in your website.
#pod
#pod To add an image using Markdown, use C.
#pod
#pod =head2 Customize Template and Layout
#pod
#pod The easiest way to customize the look of the site is to edit the layout
#pod template. Templates in Mojolicious can be in external files in
#pod a C directory, or they can be in the C script below
#pod C<__DATA__>.
#pod
#pod The layout your site uses currently is called
#pod C.  The two main things to put in a layout are
#pod C<< <%= title %> >> for the page's title and C<< <%= content %> >> for
#pod the page's content. Otherwise, the layout can be used to add design and
#pod navigation for your site.
#pod
#pod =head1 ADVANCED FEATURES
#pod
#pod =head2 Custom Metadata Fields
#pod
#pod You can add additional metadata fields to your page by adding them to
#pod your schema, like so:
#pod
#pod     plugin Yancy => {
#pod         backend => 'static:.',
#pod         read_schema => 1,
#pod         schema => {
#pod             pages => {
#pod                 properties => {
#pod                     # Add an optional 'author' field
#pod                     author => { type => [ 'string', 'null' ] },
#pod                 },
#pod             },
#pod         },
#pod     };
#pod
#pod These additional fields can be used in your template through the
#pod C<$item> hash reference (C<< $item->{author} >>).  See
#pod L for more information about configuring a schema.
#pod
#pod =head2 Character Encoding
#pod
#pod By default, this backend detects the locale of your current environment
#pod and assumes the files you read and write should be in that encoding. If
#pod this is incorrect (if, for example, you always want to read/write UTF-8
#pod files), add a C to the backend string:
#pod
#pod     use Mojolicious::Lite;
#pod     plugin Yancy => {
#pod         backend => 'static:.?encoding=UTF-8',
#pod         read_schema => 1,
#pod     };
#pod
#pod =head1 SEE ALSO
#pod
#pod L, L
#pod
#pod =cut

use Mojo::Base -base;
use Mojo::File;
use Text::Markdown;
use YAML ();
use JSON::PP ();
use Yancy::Util qw( match order_by );

# Can't use open ':locale' because it caches the current locale (so it
# won't work in tests unless we create a new process with the changed
# locale...)
use I18N::Langinfo qw( langinfo CODESET );
use Encode qw( encode decode );

has schema => sub { +{} };
has path =>;
has markdown_parser => sub { Text::Markdown->new };
has encoding => sub { langinfo( CODESET ) };

sub new {
    my ( $class, $backend, $schema ) = @_;
    my ( undef, $path ) = split /:/, $backend, 2;
    $path =~ s/^([^?]+)\?(.+)$/$1/;
    my %attrs = map { split /=/ } split /\&/, $2 // '';
    return $class->SUPER::new( {
        %attrs,
        path => Mojo::File->new( $path ),
        ( schema => $schema )x!!$schema,
    } );
}

sub create {
    my ( $self, $schema, $params ) = @_;

    my $path = $self->path->child( $self->_id_to_path( $params->{slug} ) );
    $self->_write_file( $path, $params );
    return $params->{slug};
}

sub get {
    my ( $self, $schema, $id ) = @_;

    # Allow directory path to work. Must have a trailing slash to ensure
    # that relative links in the file work correctly.
    if ( $id =~ m{/$} && -d $self->path->child( $id ) ) {
        $id .= 'index.markdown';
    }
    else {
        # Clean up the input path
        $id =~ s/\.\w+$//;
        $id .= '.markdown';
    }

    my $path = $self->path->child( $id );
    #; say "Getting path $id: $path";
    return undef unless -f $path;

    my $item = eval { $self->_read_file( $path ) };
    if ( $@ ) {
        warn sprintf 'Could not load file %s: %s', $path, $@;
        return undef;
    }
    $item->{slug} = $self->_path_to_id( $path->to_rel( $self->path ) );
    $self->_normalize_item( $schema, $item );
    return $item;
}

sub _normalize_item {
    my ( $self, $schema_name, $item ) = @_;
    return unless my $schema = $self->schema->{ $schema_name };
    for my $prop_name ( keys %{ $item } ) {
        next unless my $prop = $schema->{ properties }{ $prop_name };
        if ( $prop->{type} eq 'array' && ref $item->{ $prop_name } ne 'ARRAY' ) {
            $item->{ $prop_name } = [ $item->{ $prop_name } ];
        }
    }
}

sub list {
    my ( $self, $schema, $params, $opt ) = @_;
    $params ||= {};
    $opt ||= {};

    my @items;
    my $total = 0;
    PATH: for my $path ( sort $self->path->list_tree->each ) {
        next unless $path =~ /[.](?:markdown|md)$/;
        my $item = eval { $self->_read_file( $path ) };
        if ( $@ ) {
            warn sprintf 'Could not load file %s: %s', $path, $@;
            next;
        }
        $item->{slug} = $self->_path_to_id( $path->to_rel( $self->path ) );
        $self->_normalize_item( $schema, $item );
        next unless match( $params, $item );
        push @items, $item;
        $total++;
    }

    $opt->{order_by} //= 'slug';
    my $ordered_items = order_by( $opt->{order_by}, \@items );

    my $start = $opt->{offset} // 0;
    my $end = $opt->{limit} ? $start + $opt->{limit} - 1 : $#items;
    if ( $end > $#items ) {
        $end = $#items;
    }

    return {
        items => [ @{$ordered_items}[ $start .. $end ] ],
        total => $total,
    };
}

sub set {
    my ( $self, $schema, $id, $params ) = @_;
    my $path = $self->path->child( $self->_id_to_path( $id ) );
    # Load the current file to turn a partial set into a complete
    # set
    my %item = (
        -f $path ? %{ $self->_read_file( $path ) } : (),
        %$params,
    );

    if ( $params->{slug} ) {
      my $new_path = $self->path->child( $self->_id_to_path( $params->{slug} ) );
      if ( -f $path and $new_path ne $path ) {
         $path->remove;
      }
      $path = $new_path;
    }
    $self->_write_file( $path, \%item );
    return 1;
}

sub delete {
    my ( $self, $schema, $id ) = @_;
    return !!unlink $self->path->child( $self->_id_to_path( $id ) );
}

sub read_schema {
    my ( $self, @schemas ) = @_;
    my %page_schema = (
        type => 'object',
        title => 'Pages',
        required => [qw( slug markdown )],
        'x-id-field' => 'slug',
        'x-view-item-url' => '/{slug}',
        'x-list-columns' => [ 'title', 'slug' ],
        properties => {
            slug => {
                type => 'string',
                'x-order' => 2,
            },
            title => {
                type => 'string',
                'x-order' => 1,
            },
            markdown => {
                type => 'string',
                format => 'markdown',
                'x-html-field' => 'html',
                'x-order' => 3,
            },
            html => {
                type => 'string',
            },
        },
    );
    return @schemas ? \%page_schema : { pages => \%page_schema };
}

sub _id_to_path {
    my ( $self, $id ) = @_;
    # Allow indexes to be created
    if ( $id =~ m{(?:^|\/)index$} ) {
        $id .= '.markdown';
    }
    # Allow full file paths to be created
    elsif ( $id =~ m{\.\w+$} ) {
        $id =~ s{\.\w+$}{.markdown};
    }
    # Anything else should create a file
    else {
        $id .= '.markdown';
    }
    return $id;
}

sub _path_to_id {
    my ( $self, $path ) = @_;
    my $dir = $path->dirname;
    $dir =~ s/^\.//;
    return join '/', grep !!$_, $dir, $path->basename( '.markdown' );
}

sub _read_file {
    my ( $self, $path ) = @_;
    open my $fh, '<', $path or die "Could not open $path for reading: $!";
    local $/;
    return $self->_parse_content( decode( $self->encoding, scalar <$fh>, Encode::FB_CROAK ) );
}

sub _write_file {
    my ( $self, $path, $item ) = @_;
    if ( !-d $path->dirname ) {
        $path->dirname->make_path;
    }
    #; say "Writing to $path:\n$content";
    open my $fh, '>', $path
        or die "Could not open $path for overwriting: $!";
    print $fh encode( $self->encoding, $self->_deparse_content( $item ), Encode::FB_CROAK );
    return;
}

#=sub _parse_content
#
#   my $item = $backend->_parse_content( $path->slurp );
#
# Parse a file's frontmatter and Markdown. Returns a hashref
# ready for use as an item.
#
#=cut

sub _parse_content {
    my ( $self, $content ) = @_;
    my %item;

    my @lines = split /\n/, $content;
    # YAML frontmatter
    if ( @lines && $lines[0] =~ /^---/ ) {

        # The next --- is the end of the YAML frontmatter
        my ( $i ) = grep { $lines[ $_ ] =~ /^---/ } 1..$#lines;

        # If we did not find the marker between YAML and Markdown
        if ( !defined $i ) {
            die qq{Could not find end of YAML front matter (---)\n};
        }

        # Before the marker is YAML
        eval {
            %item = %{ YAML::Load( join "\n", splice( @lines, 0, $i ), "" ) };
            %item = map {$_ => do {
              # YAML.pm 1.29 doesn't parse 'true', 'false' as booleans
              # like the schema suggests: https://yaml.org/spec/1.2/spec.html#id2803629
              my $v = $item{$_};
              $v = JSON::PP::false if $v and $v eq 'false';
              $v = JSON::PP::true if $v and $v eq 'true';
              $v
            }} keys %item;
        };
        if ( $@ ) {
            die qq{Error parsing YAML\n$@};
        }

        # Remove the last '---' mark
        shift @lines;
    }
    # JSON frontmatter
    elsif ( @lines && $lines[0] =~ /^{/ ) {
        my $json;
        if ( $lines[0] =~ /\}$/ ) {
            # The JSON is all on a single line
            $json = shift @lines;
        }
        else {
            # The } on a line by itself is the last line of JSON
            my ( $i ) = grep { $lines[ $_ ] =~ /^}$/ } 0..$#lines;
            # If we did not find the marker between YAML and Markdown
            if ( !defined $i ) {
                die qq{Could not find end of JSON front matter (\})\n};
            }
            $json = join "\n", splice( @lines, 0, $i+1 );
        }
        eval {
            %item = %{ JSON::PP->new()->utf8(0)->decode( $json ) };
        };
        if ( $@ ) {
            die qq{Error parsing JSON: $@\n};
        }
    }

    # The remaining lines are content
    $item{ markdown } = join "\n", @lines, "";
    $item{ html } = $self->markdown_parser->markdown( $item{ markdown } );

    return \%item;
}

sub _deparse_content {
    my ( $self, $item ) = @_;
    my %data =
        map { $_ => do {
        my $v = $item->{ $_ };
          JSON::PP::is_bool($v) ? $v ? 'true' : 'false' : $v
        }}
        grep { !/^(?:markdown|html|slug)$/ }
        keys %$item;
    return ( %data ? YAML::Dump( \%data ) . "---\n" : "") . ( $item->{markdown} // "" );
}

1;

__END__