From 1b53b6e07dbd04c6939f58a0e326b2f0366ae394 Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Wed, 9 Aug 2017 17:34:28 -0400 Subject: [PATCH 1/8] read_document should use read_file --- lib/Statocles/Store.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Statocles/Store.pm b/lib/Statocles/Store.pm index 2cdc37ae..c67b2e0c 100644 --- a/lib/Statocles/Store.pm +++ b/lib/Statocles/Store.pm @@ -164,7 +164,7 @@ sub read_document { site->log->debug( "Read document: " . $path ); my $full_path = $self->path->child( $path ); my $relative_path = $full_path->relative( cwd ); - my %doc = $self->parse_frontmatter( $relative_path, $full_path->slurp_utf8 ); + my %doc = $self->parse_frontmatter( $relative_path, $self->read_file( $path ) ); my $class = $doc{class} ? use_module( delete $doc{class} ) : 'Statocles::Document'; my $obj = eval { $class->new( %doc, path => $path, store => $self ) }; if ( $@ ) { From ebbca80fbd6cf5dc9fc690630f86dda54ca02139 Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Fri, 11 Aug 2017 15:33:08 -0400 Subject: [PATCH 2/8] improve write_file documentation --- lib/Statocles/Store.pm | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/lib/Statocles/Store.pm b/lib/Statocles/Store.pm index c67b2e0c..8266d9af 100644 --- a/lib/Statocles/Store.pm +++ b/lib/Statocles/Store.pm @@ -398,9 +398,24 @@ sub open_file { Write the given C to the given C. This is mostly used to write out L. -C may be a simple string or a filehandle. If given a string, will -write the string using UTF-8 characters. If given a filehandle, will write out -the raw bytes read from it with no special encoding. +C may be a: + +=over + +=item * + +a simple string, which will be written using UTF-8 characters. + +=item * + +a L object whose C method will be used to +write it; + +=item * + +a filehandle which will be read from with no special encoding. + +=back =cut From 5f9b98bddb96475cc5c434a22aec118b3f78721f Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Fri, 11 Aug 2017 15:34:39 -0400 Subject: [PATCH 3/8] read_documents now uses find_files rather than duplicating its functionality --- lib/Statocles/Store.pm | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/lib/Statocles/Store.pm b/lib/Statocles/Store.pm index 8266d9af..d5f357dd 100644 --- a/lib/Statocles/Store.pm +++ b/lib/Statocles/Store.pm @@ -121,16 +121,15 @@ objects|Statocles::Document> inside. Returns an arrayref of document objects. sub read_documents { my ( $self ) = @_; - $self->_check_exists; + my $root_path = $self->path; + my @docs; - my $iter = $root_path->iterator( { recurse => 1, follow_symlinks => 1 } ); + my $iter = $self->find_files( include_documents => 1 ); + while ( my $path = $iter->() ) { - next unless $path->is_file; - next unless $self->_is_owned_path( $path ); next unless $self->is_document( $path ); - my $rel_path = rootdir->child( $path->relative( $root_path ) ); - push @docs, $self->read_document( $rel_path ); + push @docs, $self->read_document( $path ); } return \@docs; } @@ -336,7 +335,7 @@ object or undef if no files remain. It is used by L. sub files { my ( $self ) = @_; - return $self->path->iterator({ recurse => 1 }); + return $self->path->iterator({ recurse => 1, follow_symlinks => 1 }); } From 5e0d6b0fb848736eba69890f20d01815704f7261 Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Fri, 11 Aug 2017 15:36:42 -0400 Subject: [PATCH 4/8] write_document now properly uses write_file --- lib/Statocles/Store.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Statocles/Store.pm b/lib/Statocles/Store.pm index d5f357dd..50981bbb 100644 --- a/lib/Statocles/Store.pm +++ b/lib/Statocles/Store.pm @@ -256,7 +256,7 @@ sub write_document { chomp $header; my $full_path = $self->path->child( $path ); - $full_path->touchpath->spew_utf8( join "\n", $header, '---', $content ); + $self->write_file( $path, join "\n", $header, '---', $content ); if ( defined wantarray ) { derp "Statocles::Store->write_document returning a value is deprecated and will be removed in v1.0. Use Statocles::Store->path to find the full path to the document."; From 44c942f95fba717222c1b7046169b06b063f9c52 Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Fri, 11 Aug 2017 16:43:22 -0400 Subject: [PATCH 5/8] move file check out of find_files() into files() we only care about files anyway, so moving the file check into files() a) ensures that files() lives up to its name; and b) makes find_files a bit more generic, so that it eventually doesn't have to check the filesytem at all. it still calls _check_exists. --- lib/Statocles/Store.pm | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/lib/Statocles/Store.pm b/lib/Statocles/Store.pm index 50981bbb..643d039e 100644 --- a/lib/Statocles/Store.pm +++ b/lib/Statocles/Store.pm @@ -335,7 +335,14 @@ object or undef if no files remain. It is used by L. sub files { my ( $self ) = @_; - return $self->path->iterator({ recurse => 1, follow_symlinks => 1 }); + my $iter = $self->path->iterator({ recurse => 1, follow_symlinks => 1 }); + + sub { + while( my $path = $iter->() ) { + return $path if $path->is_file; + } + return; + } } @@ -365,7 +372,6 @@ sub find_files { return sub { my $path; while ( $path = $iter->() ) { - next if $path->is_dir; next if !$self->_is_owned_path( $path ); next if !$opt{include_documents} && $self->is_document( $path ); last; From 2534479b26fdf9e4516d02d5790228b96bbb6479 Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Fri, 11 Aug 2017 16:58:30 -0400 Subject: [PATCH 6/8] remove open_file() Users of Store shouldn't have direct access to a file, as it prevents Store from using non-filesystem based backends. --- lib/Statocles/Store.pm | 15 --------------- t/store/file.t | 10 ---------- 2 files changed, 25 deletions(-) diff --git a/lib/Statocles/Store.pm b/lib/Statocles/Store.pm index 643d039e..7422903d 100644 --- a/lib/Statocles/Store.pm +++ b/lib/Statocles/Store.pm @@ -381,21 +381,6 @@ sub find_files { }; } -=method open_file - - my $fh = $store->open_file( $path ) - -Open the file with the given path. Returns a filehandle. - -The filehandle opened is using raw bytes, not UTF-8 characters. - -=cut - -sub open_file { - my ( $self, $path ) = @_; - return $self->path->child( $path )->openr_raw; -} - =method write_file $store->write_file( $path, $content ); diff --git a/t/store/file.t b/t/store/file.t index 6c135696..ff00abe8 100644 --- a/t/store/file.t +++ b/t/store/file.t @@ -66,16 +66,6 @@ subtest 'find files' => sub { }; -subtest 'open file' => sub { - my $store = Statocles::Store->new( - path => $SHARE_DIR->child( qw( store files ) ), - ); - - my $fh = $store->open_file( path( 'text.txt' ) ); - my $content = do { local $/; <$fh> }; - eq_or_diff $content, $SHARE_DIR->child( qw( store files text.txt ) )->slurp_raw; -}; - subtest 'write files' => sub { subtest 'string' => sub { From 4db82a28b241fd20dd2b36158493e9f5dcb11d3d Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Fri, 18 Aug 2017 16:53:15 -0400 Subject: [PATCH 7/8] allow subclasses to resolve a path Not all store backends will be filesystem based, so using Path::Tiny's realpath method won't work for them. --- lib/Statocles/Store.pm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/lib/Statocles/Store.pm b/lib/Statocles/Store.pm index 7422903d..593d7e76 100644 --- a/lib/Statocles/Store.pm +++ b/lib/Statocles/Store.pm @@ -73,7 +73,7 @@ has _realpath => ( is => 'ro', isa => Path, lazy => 1, - default => sub { $_[0]->path->realpath }, + default => sub { $_[0]->_resolve_path( $_[0]->path ) }, ); # If true, we've already checked if this store's path exists. We need to @@ -134,10 +134,15 @@ sub read_documents { return \@docs; } +sub _resolve_path { + my ( $self, $path ) = @_; + return $path->realpath; +} + sub _is_owned_path { my ( $self, $path ) = @_; my $self_path = $self->_realpath; - $path = $path->realpath; + $path = $self->_resolve_path( $path ); my $dir = $path->parent; for my $store_path ( keys %FILE_STORES ) { # This is us! From 5da8a794aaf530ef7f318ffd4166555695013fe8 Mon Sep 17 00:00:00 2001 From: Diab Jerius Date: Fri, 18 Aug 2017 17:04:06 -0400 Subject: [PATCH 8/8] add non-filesystem based storage backend; update tests and Store to work with it A new storage backend, Store::Archive::Tar is included as an example and to allow testing. In order to accomodate testing of multiple backends the t/store tests were converted into Moo::Role's. These are applied to a My::Test::Store class which is instantiated for each storage backend. The roles are discovered via Mojo::Loader, so it's simple to add new ones. The disadvantage to this approach is that the tests are no longer easily parallalizeable. The t/store test suite assumed filesystem based storage, and often went directly to disk rather than use the Store API. The suite now uses the Store API exclusively. There was one addition to the API to support this, namely Store::read_file_raw(), which unlink read_file() peforms no decoding of the data from the file. --- lib/Statocles/Store.pm | 16 +- lib/Statocles/Store/Archive/Tar.pm | 272 ++++++++++++++++++ t/lib/My/Test/Store.pm | 117 ++++++++ t/lib/My/Test/Store/constructor.pm | 51 ++++ t/lib/My/Test/Store/document.pm | 440 +++++++++++++++++++++++++++++ t/lib/My/Test/Store/file.pm | 296 +++++++++++++++++++ t/store/constructor.t | 26 -- t/store/document.t | 392 ------------------------- t/store/file.t | 234 --------------- t/store/store.t | 37 +++ t/store/tar.t | 77 +++++ 11 files changed, 1305 insertions(+), 653 deletions(-) create mode 100644 lib/Statocles/Store/Archive/Tar.pm create mode 100644 t/lib/My/Test/Store.pm create mode 100644 t/lib/My/Test/Store/constructor.pm create mode 100644 t/lib/My/Test/Store/document.pm create mode 100644 t/lib/My/Test/Store/file.pm delete mode 100644 t/store/constructor.t delete mode 100644 t/store/document.t delete mode 100644 t/store/file.t create mode 100644 t/store/store.t create mode 100644 t/store/tar.t diff --git a/lib/Statocles/Store.pm b/lib/Statocles/Store.pm index 593d7e76..52073d88 100644 --- a/lib/Statocles/Store.pm +++ b/lib/Statocles/Store.pm @@ -302,7 +302,7 @@ sub is_document { my $content = $store->read_file( $path ) -Read the file from the given C. +Read the file from the given C as UTF8 encoded data. =cut @@ -312,6 +312,20 @@ sub read_file { return $self->path->child( $path )->slurp_utf8; } +=method read_file_raw + + my $content = $store->read_file_raw( $path ) + +Read the file from the given C as raw data. + +=cut + +sub read_file_raw { + my ( $self, $path ) = @_; + site->log->debug( "Read file: " . $path ); + return $self->path->child( $path )->slurp_raw; +} + =method has_file my $bool = $store->has_file( $path ) diff --git a/lib/Statocles/Store/Archive/Tar.pm b/lib/Statocles/Store/Archive/Tar.pm new file mode 100644 index 00000000..a5be0adb --- /dev/null +++ b/lib/Statocles/Store/Archive/Tar.pm @@ -0,0 +1,272 @@ +package Statocles::Store::Archive::Tar; +our $VERSION = '0.085'; +# ABSTRACT: The source for data documents and files + +use Statocles::Base 'Class'; +use File::Spec; +use Scalar::Util qw[ blessed ]; +use Moo; +use Carp (); + +extends 'Statocles::Store'; + + +use Encode; +use Archive::Tar; + +=attr path + +The path to the directory which will appear to contain the L. + +=cut + +has archive => ( + is => 'ro', + isa => ( InstanceOf ['Archive::Tar'] ) + ->plus_coercions( Str, sub { Archive::Tar->new( $_ ) }, + Path, sub { Archive::Tar->new( $_ ) }, + ), + coerce => 1, + required => 1 +); + +has archive_root => ( + is => 'ro', + isa => Path, + coerce => 1, + required => 1, +); + +has archive_strip => ( + is => 'ro', + isa => Str | Path, + coerce => 1, + default => '' +); + +has '_real_archive_root' => ( + is => 'ro', + isa => Path, + lazy => 1, + default => sub { $_[0]->_resolve_path( $_[0]->archive_root ) }, +); + + +sub _resolve_path { + + my ( $self, $path ) = @_; + + # use Devel::StackTrace; + # print Devel::StackTrace->new->as_string; + + $path = $self->archive_root->child( $path )->absolute + if $path->is_relative; + + # Path::Tiny::parent correctly refuses to interpret '..', + # so we can't use it. + + # Since our paths are not really filesystem paths, we can fudge + # things + + ( my $volume, $path, my $file ) = File::Spec->splitpath( $path->stringify ); + my @segments = File::Spec->splitdir( $path ); + + my @path; + while ( @segments ) { + my $segment = shift @segments; + pop @path and next if $segment eq '..'; + push @path, $segment; + } + + Path::Tiny::path( + File::Spec->catpath( $volume, File::Spec->catdir( @path ), $file ) ); +} + +sub _archive_path { + + my ( $self, $path ) = @_; + + my $pfx = $self->_realpath->relative( $self->_real_archive_root ); + + my $file = $self->archive_strip->child( $pfx->child( $path ) ); + + return $file; +} + +=method read_file + + my $content = $store->read_file( $path ) + +Read the file from the given C. + +=cut + +sub read_file { + my ( $self, $path ) = @_; + site->log->debug( "Read file: " . $path ); + local $SIG{__WARN__} = sub { Carp::croak $self->archive->error }; + return decode( 'utf8', + $self->archive->get_content( $self->_archive_path( $path ) ) ); +} + +sub read_file_raw { + my ( $self, $path ) = @_; + site->log->debug( "Read file: " . $path ); + local $SIG{__WARN__} = sub { Carp::croak $self->archive->error }; + return $self->archive->get_content( $self->_archive_path( $path ) ); +} + +=method has_file + + my $bool = $store->has_file( $path ) + +Returns true if a file exists with the given C. + +NOTE: This should not be used to check for directories, as not all stores have +directories. + +=cut + +sub has_file { + my ( $self, $path ) = @_; + return $self->archive->contains_file( $self->_archive_path( $path ) ); +} + +=method files + + my $iter = $store->files + +Returns an iterator which iterates over I files in the store, +regardless of type of file. The iterator returns a L +object or undef if no files remain. It is used by L. + +=cut + +sub files { + my ( $self ) = @_; + + my @files + = map { $_->full_path } grep { $_->is_file } $self->archive->get_files; + + sub { + + my $realpath = $self->_realpath; + my $archive_root = $self->_real_archive_root; + while ( @files ) { + + my $file = Path::Tiny::path( shift @files ); + $file = $file->relative( $self->archive_strip ); + $file = $self->archive_root->child( $file ); + my $realfile = $self->_resolve_path( $file ); + return $realfile if $realpath->subsumes( $realfile ); + + } + return undef; + + } +} + + +=method write_file + + $store->write_file( $path, $content ); + +Write the given C to the given C. This is mostly used to write +out L. + +C may be a: + +=over + +=item * + +a simple string, which will be written using UTF-8 characters. + +=item * + +a L object whose C method will be used to +write it; + +=item * + +a filehandle which will be read from with no special encoding. + +=back + +=cut + +sub write_file { + my ( $self, $path, $content ) = @_; + site->log->debug( "Write file: " . $path ); + + my $file = $self->_archive_path( $path ); + + if ( ref $content eq 'GLOB' ) { + $self->archive->add_data( $file, join( '', <$content> ) ); + } + elsif ( blessed $content && $content->isa( 'Path::Tiny' ) ) { + $self->archive->add_data( $file, $content->slurp_raw ); + } + else { + $self->archive->add_data( $file, encode( 'utf8', $content ) ); + } + + return; +} + +=method remove + + $store->remove( $path ) + +Remove the given path from the store. If the path is a directory, the entire +directory is removed. + +=cut + +sub remove { + my ( $self, $path ) = @_; + + # $path may be a file or a directory + $path = $self->_archive_path( $path ); + + my $entry = do { + local $SIG{__WARN__} = sub { }; + ( $self->archive->get_files( $path ) )[0]; + }; + + if ( defined $entry && !$entry->is_dir ) { + $self->archive->remove( $path ); + } + else { + + my @paths = grep { $path->subsumes( $_ ) } + map { $_->full_path } $self->archive->get_files; + $self->archive->remove( @paths ); + } + return; +} + +1; +__END__ + +=head1 DESCRIPTION + +A Statocles::Store reads and writes L and +files (mostly L). + +This class also handles the parsing and inflating of +L<"document objects"|Statocles::Document>. + +=head2 Frontmatter Document Format + +Documents are formatted with a YAML document on top, and Markdown content +on the bottom, like so: + + --- + title: This is a title + author: preaction + --- + # This is the markdown content + + This is a paragraph + diff --git a/t/lib/My/Test/Store.pm b/t/lib/My/Test/Store.pm new file mode 100644 index 00000000..9fdd86cb --- /dev/null +++ b/t/lib/My/Test/Store.pm @@ -0,0 +1,117 @@ +package My::Test::Store; + +use Getopt::Long; + +use My::Test; +use Mojo::Loader qw( find_modules load_class ); +use Statocles::Base 'Role'; + + +my @modules; + +BEGIN { + @modules = find_modules( __PACKAGE__ ); +} + + +has class => ( + is => 'ro', + isa => Str, + required => 1, +); + +has share_dir => ( + is => 'ro', + isa => AbsPath, + coerce => 1, + required => 1, +); + +sub run_tests { } + +my %tests; + +INIT { + + my $package = __PACKAGE__; + + my %opts; + GetOptions( \ %opts, 'include|I=s@', 'exclude|I=s@' ) + or die( "can't parse options" ); + + if ( $opts{include} ) { + + for my $include ( @{ $opts{include} } ) { + + if ( $include =~ m{^/.*/$} ) { + + ( $include ) = $include =~ m{/(.*)/}; + $include = qr/$include/; + + $tests{$_} = undef for grep { + ( my $test = $_ ) =~ s/^${package}:://; + $test =~ $include; + } @modules; + } + else { + $tests{$_} = undef for grep { $_ eq __PACKAGE__ . '::' . $include } @modules; + } + } + + } + + else { + + @tests{@modules} = undef; + } + + if ( $opts{exclude} ) { + + for my $exclude ( @{ $opts{exclude} } ) { + + if ( $exclude =~ m{^/.*/$} ) { + $exclude = qr/$exclude/; + + delete $tests{$_} for grep { + ( my $test = $_ ) =~ s/^${package}:://; + $test =~ $exclude + } @modules; + } + else { + delete $tests{$_} for grep { $_ eq __PACKAGE__ . '::' . $exclude } @modules; + } + + } + } + + + with $_ for keys %tests; + + around run_tests => sub { + + my $orig = shift; + my $self = shift; + + + subtest $self->class => sub { + + $self->$orig( @_ ); + + }; + + }; + +} + + +sub build { + + my $self = shift; + my $class = $self->class; + + $class->new( $self->args( @_ ) ); +} + +requires 'args'; +requires 'required'; +1; diff --git a/t/lib/My/Test/Store/constructor.pm b/t/lib/My/Test/Store/constructor.pm new file mode 100644 index 00000000..f7f8e68a --- /dev/null +++ b/t/lib/My/Test/Store/constructor.pm @@ -0,0 +1,51 @@ +package My::Test::Store::constructor; + +use Test::Lib; +use My::Test; +use Module::Load; + +use Moo::Role; + +my $test_constructor = sub { + + my $self = shift; + + load $self->class; + + my $site = build_test_site( theme => $self->share_dir->child( 'theme' ) ); + + test_constructor( + $self->class, + required => $self->required( path => $self->share_dir->child( qw( store docs ) ) ), + ); + + subtest 'warn if path does not exist' => sub { + my $path = $self->share_dir->child( qw( DOES_NOT_EXIST ) ); + lives_ok { + $self->build( path => $path )->read_documents; + } + 'store created with nonexistent path'; + + cmp_deeply $site->log->history->[-1], + [ ignore(), 'warn', qq{Store path "$path" does not exist} ] + or diag explain $site->log->history->[-1]; + }; + + +}; + +around run_tests => sub { + + my $orig = shift; + + my $self = shift; + + $self->$orig( @_ ); + + subtest constructor => sub { $self->$test_constructor }; +}; + + + +1; + diff --git a/t/lib/My/Test/Store/document.pm b/t/lib/My/Test/Store/document.pm new file mode 100644 index 00000000..2f829387 --- /dev/null +++ b/t/lib/My/Test/Store/document.pm @@ -0,0 +1,440 @@ +package My::Test::Store::document; + +use Test::Lib; +use My::Test; +use Statocles::Util qw( dircopy ); +use Capture::Tiny qw( capture ); +use TestDocument; +use Module::Load; + + +use Moo::Role; + +sub expect_docs { + my ( $store ) = @_; + + return ( + Statocles::Document->new( + path => '/required.markdown', + title => 'Required Document', + author => 'preaction', + content => "No optional things in here, at all!\n", + store => $store, + ), + + Statocles::Document->new( + path => '/ext/short.md', + title => 'Short Extension', + content => "This is a short extension\n", + store => $store, + ), + + Statocles::Document->new( + path => '/no-frontmatter.markdown', + content => + "\n# This Document has no frontmatter!\n\nDocuments are not required to have frontmatter!\n", + store => $store, + ), + + Statocles::Document->new( + path => '/path.markdown', + title => 'Document with path inside', + author => 'preaction', + content => "The path is in the file, and it must be ignored.\n", + store => $store, + ), + + Statocles::Document->new( + path => '/datetime.markdown', + title => 'Datetime Document', + author => 'preaction', + date => DateTimeObj->coerce( '2014-04-30 15:34:32' ), + content => "Parses date/time for date\n", + store => $store, + ), + + Statocles::Document->new( + path => '/date.markdown', + title => 'Date Document', + author => 'preaction', + date => DateTimeObj->coerce( '2014-04-30' ), + content => "Parses date only for date\n", + store => $store, + ), + + Statocles::Document->new( + path => '/links/alternate_single.markdown', + title => 'Linked Document', + author => 'preaction', + content => "This document has a single alternate link\n", + links => { + alternate => [ { + title => 'blogs.perl.org', + href => 'http://blogs.perl.org/preaction/404.html', + }, + ], + }, + store => $store, + ), + + Statocles::Document->new( + path => '/tags/single.markdown', + title => 'Tagged (Single) Document', + author => 'preaction', + tags => [qw( single )], + content => "This document has a single tag\n", + store => $store, + ), + + Statocles::Document->new( + path => '/tags/array.markdown', + title => 'Tagged (Array) Document', + author => 'preaction', + tags => [ 'multiple', 'tags', 'in an', 'array' ], + content => "This document has multiple tags in an array\n", + store => $store, + ), + + Statocles::Document->new( + path => '/tags/comma.markdown', + title => 'Tagged (Comma) Document', + author => 'preaction', + tags => [ "multiple", "tags", "separated by", "commas" ], + content => "This document has multiple tags separated by commas\n", + store => $store, + ), + + + Statocles::Document->new( + path => '/template/basic.markdown', + title => 'Template document', + content => "This document has a template\n", + template => [qw( document basic.html.ep )], + layout => [qw( site basic.html.ep )], + store => $store, + ), + + Statocles::Document->new( + path => '/template/leading-slash.markdown', + title => 'Template (Slash) document', + content => "This document has a template with a leading slash\n", + template => [qw( document slash.html.ep )], + layout => [qw( site slash.html.ep )], + store => $store, + ), + + TestDocument->new( + path => '/class/test_document.markdown', + title => 'Test Class', + content => "This is a custom class\n", + store => $store, + ), + ); +} + +my $test_document = sub { + my $self = shift; + + load $self->class; + + build_test_site( theme => $self->share_dir->child( 'theme' ) ); + + my $DT_FORMAT = '%Y-%m-%d %H:%M:%S'; + + my $ignored_store = $self->build( + path => $self->share_dir->child( qw( store docs ignore ) ) ); + + subtest 'read documents' => sub { + my $store + = $self->build( + path => $self->share_dir->child( qw( store docs ) ) ); + + cmp_deeply $store->documents, bag( expect_docs( $store ) ) + or diag explain $store->documents; + + subtest 'clear documents' => sub { + # Edit the document + $store->documents->[0]->title( 'This is a new title' ); + # Clear all the documents + $store->clear; + # Re-read them from disk + cmp_deeply $store->documents, bag( expect_docs( $store ) ) + or diag explain $store->documents; + }; + }; + + subtest 'parse frontmatter from content' => sub { + my $store = $self->build( path => tempdir ); + my $path + = $self->share_dir->child( qw( store docs required.markdown ) ); + cmp_deeply { $store->parse_frontmatter( $path, $path->slurp_utf8 ) } + , + { + title => 'Required Document', + author => 'preaction', + content => "No optional things in here, at all!\n", + }; + + subtest 'does not warn without content' => sub { + my @warnings; + local $SIG{__WARN__} = sub { push @warnings, @_ }; + cmp_deeply { $store->parse_frontmatter( 'UNDEF' ) }, + {}, + 'empty hashref'; + ok !@warnings, 'no warnings' or diag explain \@warnings; + }; + + subtest 'does not warn without more than one line' => sub { + my @warnings; + local $SIG{__WARN__} = sub { push @warnings, @_ }; + cmp_deeply { + $store->parse_frontmatter( 'one line', 'only one line' ) + }, { content => "only one line\n" }, 'empty hashref'; + ok !@warnings, 'no warnings' or diag explain \@warnings; + }; + + subtest 'does not warn with only a newline' => sub { + my @warnings; + local $SIG{__WARN__} = sub { push @warnings, @_ }; + cmp_deeply { $store->parse_frontmatter( 'newline', "\n" ) }, + { content => '' }, + 'empty hashref'; + ok !@warnings, 'no warnings' or diag explain \@warnings; + }; + }; + + subtest 'read with relative directory' => sub { + my $cwd = cwd; + chdir $self->share_dir; + my $store = $self->build( path => 'store/docs' ); + cmp_deeply $store->documents, bag( expect_docs( $store ) ); + chdir $cwd; + }; + + subtest 'path that has regex-special characters inside' => sub { + my $tmpdir = tempdir; + my $baddir = $tmpdir->child( '[regex](name).dir' ); + my $store = $self->build( path => $baddir ); + + my $docs = $self->share_dir->child( qw( store docs ) ); + $docs->visit( + sub { + my ( $path ) = @_; + $store->write_file( $path->relative( $docs ), $path ) + if $path->is_file; + }, { recurse => 1 } + ); + + my $ignored_store + = $self->build( path => $baddir->child( qw( ignore ) ) ); + cmp_deeply $store->documents, bag( expect_docs( $store ) ) + or diag join "\n", + map { $_->path->stringify } @{ $store->documents }; + }; + + subtest 'bad documents' => sub { + subtest 'no ending frontmatter mark' => sub { + my $store + = $self->build( path => + $self->share_dir->child( qw( store error missing-end-mark ) ), + ); + my $from + = $store->path->child( 'missing.markdown' )->relative( cwd ) + ->stringify; + throws_ok { $store->documents } + qr{\QCould not find end of front matter (---) in "$from"}; + }; + + subtest 'invalid yaml' => sub { + my $store + = $self->build( + path => $self->share_dir->child( qw( store error bad-yaml ) ), + ); + my $from + = $store->path->child( 'bad.markdown' )->relative( cwd ) + ->stringify; + throws_ok { $store->documents } + qr{\QError parsing YAML in "$from"}; + }; + + subtest 'invalid date/time' => sub { + my $store + = $self->build( + path => $self->share_dir->child( qw( store error bad-dates ) ), + ); + my $from + = $store->path->child( 'bad-date.markdown' )->relative( cwd ) + ->stringify; + throws_ok { $store->documents } + qr{\QCould not parse date "11/12/2014" in "$from": Does not match "YYYY-MM-DD" or "YYYY-MM-DD HH:MM:SS"}; + }; + + subtest 'invalid links structure' => sub { + my $store + = $self->build( + path => $self->share_dir->child( qw( store error bad-links ) ), + ); + my $from + = $store->path->child( 'links.markdown' )->relative( cwd ) + ->stringify; + throws_ok { $store->documents } + qr{\QError creating document in "$from": Value "bad link" is not valid for attribute "links" (expected "LinkHash")}; + }; + }; + + subtest 'write document' => sub { + no warnings 'once'; + local $YAML::Indent + = 4; # Ensure our test output matches our indentation level + my $tmpdir = tempdir; + my $store = $self->build( path => $tmpdir ); + my $tp = DateTimeObj->coerce( '2014-06-05 00:00:00' ); + my $dt = $tp->strftime( '%Y-%m-%d %H:%M:%S' ); + my $doc = { + foo => 'bar', + content => "# \x{2603} This is some content\n\nAnd a paragraph\n", + tags => [ 'one', 'two and three', 'four' ], + date => $tp, + }; + + subtest 'disallow absolute paths' => sub { + my $path = rootdir->child( 'example.markdown' ); + throws_ok { $store->write_document( $path => $doc ) } + qr{Cannot write document '$path': Path must not be absolute}; + }; + + subtest 'simple path' => sub { + my @warnings; + local $SIG{__WARN__} = sub { push @warnings, $_[0] }; + + my $path = 'example.markdown'; + $store->write_document( $path => $doc ); + cmp_deeply $store->read_document( $path ), + Statocles::Document->new( + path => 'example.markdown', + store => $store, + %$doc + ) or diag explain $store->read_document( $path ); + eq_or_diff $store->read_file( $path ), + $self->share_dir->child( qw( store write doc.markdown ) ) + ->slurp_utf8; + + ok !@warnings, 'no warnings from write' + or diag "Got warnings: \n\t" . join "\n\t", @warnings; + }; + + subtest 'make the directories if necessary' => sub { + my @warnings; + local $SIG{__WARN__} = sub { push @warnings, $_[0] }; + + my $path = path( qw( blog 2014 05 28 example.markdown ) ); + $store->write_document( $path => $doc ); + cmp_deeply $store->read_document( $path ), + Statocles::Document->new( + path => $path, + store => $store, + %$doc + ); + eq_or_diff $store->read_file( $path ), + $self->share_dir->child( qw( store write doc.markdown ) ) + ->slurp_utf8; + + ok !@warnings, 'no warnings from write' + or diag "Got warnings: \n\t" . join "\n\t", @warnings; + }; + + subtest 'allow Document objects' => sub { + my @warnings; + local $SIG{__WARN__} = sub { push @warnings, $_[0] }; + + my $doc_obj = Statocles::Document->new( + path => 'example.markdown', + store => $store, + %$doc, + ); + + my $path = 'doc_obj.markdown'; + $store->write_document( $path => $doc_obj ); + + cmp_deeply $store->read_document( $path ), + Statocles::Document->new( + path => 'doc_obj.markdown', + store => $store, + %$doc + ) or diag explain $store->read_document( $path ); + eq_or_diff $store->read_file( $path), + $self->share_dir->child( qw( store write ), $path) + ->slurp_utf8; + + ok !@warnings, 'no warnings from write' + or diag "Got warnings: \n\t" . join "\n\t", @warnings; + }; + + }; + + subtest 'removing a store reveals formerly-ignored files' => sub { + $ignored_store = undef; + my $store + = $self->build( path => $self->share_dir->child( qw( store docs ) ), + ); + my $ignored_doc = Statocles::Document->new( + path => '/ignore/ignored.markdown', + title => 'This document is ignored', + content => + "This document is ignored because it's being used by another Store\n", + store => $store, + ); + cmp_deeply $store->documents, bag( expect_docs( $store ), $ignored_doc ) + or diag explain $store->documents; + }; + + subtest 'verbose' => sub { + + local $ENV{MOJO_LOG_LEVEL} = 'debug'; + + subtest 'write' => sub { + my $tmpdir = tempdir; + my $store = $self->build( path => $tmpdir ); + + my ( $out, $err, $exit ) = capture { + $store->write_document( 'path.markdown' => { foo => 'BAR' } ); + }; + like $err, qr{\QWrite document: path.markdown}; + }; + + subtest 'read' => sub { + + my $store = $self->build( + path => $self->share_dir->child( qw( store docs ) ) ); + my $path = path( qw( required.markdown ) ); + my ( $out, $err, $exit ) = capture { + $store->read_document( $path ); + }; + like $err, qr{\QRead document: $path}; + + }; + + }; + + subtest 'check if a path is a document' => sub { + my $store + = $self->build( path => $self->share_dir->child( qw( store ) ) ); + ok $store->is_document( Path::Tiny->new( qw( docs ext short.md ) ) ); + ok $store->is_document( join "/", qw( docs ext short.md ) ); + ok !$store->is_document( Path::Tiny->new( qw( files image.png ) ) ); + ok !$store->is_document( join "/", qw( files image.png ) ); + }; + +}; + +around run_tests => sub { + + my $orig = shift; + my $self = shift; + + $self->$orig( @_ ); + subtest document => sub { $self->$test_document }; +}; + + +1; diff --git a/t/lib/My/Test/Store/file.pm b/t/lib/My/Test/Store/file.pm new file mode 100644 index 00000000..0a07618f --- /dev/null +++ b/t/lib/My/Test/Store/file.pm @@ -0,0 +1,296 @@ +package My::Test::Store::file; + + +use Test::Lib; +use My::Test; +use Capture::Tiny qw( capture ); +use Module::Load; + +use Moo::Role; + +my $test_file = sub { + + my $self = shift; + load $self->class; + + build_test_site( theme => $self->share_dir->child( 'theme' ) ); + + my $ignored_store = $self->build( + path => $self->share_dir->child( qw( store files ignore ) ), ); + + subtest 'read files' => sub { + my $store = $self->build( + path => $self->share_dir->child( qw( store files ) ), ); + eq_or_diff $store->read_file( path( 'text.txt' ) ), + $self->share_dir->child( qw( store files text.txt ) )->slurp_utf8; + }; + + subtest 'has file' => sub { + my $store = $self->build( + path => $self->share_dir->child( qw( store files ) ), ); + ok $store->has_file( path( 'text.txt' ) ); + ok !$store->has_file( path( 'missing.exe' ) ); + }; + + subtest 'find files' => sub { + my $store = $self->build( + path => $self->share_dir->child( qw( store files ) ), ); + my @expect_paths = ( + path( qw( text.txt ) )->absolute( '/' ), + path( qw( image.png ) )->absolute( '/' ), + ); + my @expect_docs + = ( path( qw( folder doc.markdown ) )->absolute( '/' ), ); + + my $iter = $store->find_files; + my @got_paths; + while ( my $path = $iter->() ) { + push @got_paths, $path; + } + + cmp_deeply \@got_paths, bag( @expect_paths ) + or diag explain \@got_paths; + + subtest 'include documents' => sub { + my $iter = $store->find_files( include_documents => 1 ); + my @got_paths; + while ( my $path = $iter->() ) { + push @got_paths, $path; + } + + cmp_deeply \@got_paths, bag( @expect_paths, @expect_docs ) + or diag explain \@got_paths; + }; + + subtest 'can pass paths to read_file' => sub { + my ( $path ) = grep { $_->basename eq 'text.txt' } @got_paths; + eq_or_diff $store->read_file( $path ), + $self->share_dir->child( qw( store files text.txt ) )->slurp_utf8; + }; + + }; + + subtest 'write files' => sub { + + subtest 'string' => sub { + my @warnings; + local $SIG{__WARN__} = sub { push @warnings, $_[0] }; + + my $tmpdir = tempdir; + my $store = $self->build( path => $tmpdir, ); + + my $content = "\x{2603} This is some plain text"; + + my $path = path( qw( store files text.txt ) ); + # write_file with string is written using UTF-8 + $store->write_file( $path, $content ); + + eq_or_diff $store->read_file( $path ), $content; + + ok !@warnings, 'no warnings from write' + or diag "Got warnings: \n\t" . join "\n\t", @warnings; + }; + + subtest 'filehandle' => sub { + my $tmpdir = tempdir; + my $store = $self->build( path => $tmpdir, ); + + subtest 'plain text files' => sub { + my @warnings; + local $SIG{__WARN__} = sub { push @warnings, $_[0] }; + + my $path = path( qw( store files text.txt ) ); + my $fh + = $self->share_dir->child( $path )->openr_raw; + + $store->write_file( $path , $fh ); + + eq_or_diff $store->read_file_raw( $path ), + $self->share_dir->child( $path )->slurp_raw; + + ok !@warnings, 'no warnings from write' + or diag "Got warnings: \n\t" . join "\n\t", @warnings; + }; + + subtest 'images' => sub { + my @warnings; + local $SIG{__WARN__} = sub { push @warnings, $_[0] }; + + my $path = path( qw( store files image.png ) ); + my $fh + = $self->share_dir->child( $path )->openr_raw; + + $store->write_file( path( $path ), $fh ); + + ok $store->read_file_raw( $path ) eq + $self->share_dir->child( $path )->slurp_raw, + 'image content is correct'; + + ok !@warnings, 'no warnings from write' + or diag "Got warnings: \n\t" . join "\n\t", @warnings; + }; + + }; + + subtest 'Path::Tiny object' => sub { + my $tmpdir = tempdir; + my $store = $self->build( path => $tmpdir, ); + + subtest 'plain text files' => sub { + my @warnings; + local $SIG{__WARN__} = sub { push @warnings, $_[0] }; + + my $path = path( qw( store files text.txt ) ); + + my $source_path = $self->share_dir->child( $path ); + + $store->write_file( $path, $source_path ); + + eq_or_diff $store->read_file_raw($path), $source_path->slurp_raw; + + ok !@warnings, 'no warnings from write' + or diag "Got warnings: \n\t" . join "\n\t", @warnings; + }; + + subtest 'images' => sub { + my @warnings; + local $SIG{__WARN__} = sub { push @warnings, $_[0] }; + + my $path = path( qw( store files image.png ) ); + my $source_path = $self->share_dir->child( $path ); + + $store->write_file( $path, $source_path ); + + ok $store->read_file_raw( $path) eq $source_path->slurp_raw, + 'image content is correct'; + + ok !@warnings, 'no warnings from write' + or diag "Got warnings: \n\t" . join "\n\t", @warnings; + }; + + }; + }; + + subtest 'remove' => sub { + + subtest 'file' => sub { + my $tmpdir = tempdir; + + my $store = $self->build( path => $tmpdir ); + + my $dir = path( 'foo', 'bar' ); + my $content = 'Hello'; + + # write two files, delete one, check that + # second file is stll there (thus so is the directory) + # cannot check if an empty directory is there, as stores + # may not have directories. + + my $f1 = path( $dir, 'baz0.txt' ); + my $f2 = path( $dir, 'baz1.txt' ); + + for my $file ( $f1, $f2 ) { + + $store->write_file( $file, $content ); + + ok $store->has_file( $file ), "file $file was created"; + + eq_or_diff $store->read_file( $file ), $content, + "stored content for $file matches"; + } + + $store->remove( $f1 ); + + ok ! $store->has_file( $f1 ), "store can't find deleted $f1"; + + throws_ok { $store->read_file( $f1 ) } qr/file/, + "store can't return contents for deleted $f1"; + + + ok $store->has_file( $f2 ), "store can still find $f2"; + + eq_or_diff $store->read_file( $f2 ), $content, + "store can return contents for $f2"; + + }; + + subtest 'directory' => sub { + my $tmpdir = tempdir; + + my $store = $self->build( path => $tmpdir ); + + my $content = 'Hello'; + + my $f1 = path( qw[ foo bar baz zero.txt ] ); + my $f2 = path( qw[ foo bar baz one.txt ] ); + my $f3 = path( qw[ foo bar zero.txt ] ); + my $f4 = path( qw[ foo zero.txt ] ); + + for my $file ( $f1, $f2, $f3, $f4 ) { + + $store->write_file( $file, $content ); + + ok $store->has_file( $file ), "file $file was created"; + + eq_or_diff $store->read_file( $file ), $content, + "stored content for $file matches"; + } + + $store->remove( path( qw( foo bar baz ) ) ); + + ok ! $store->has_file( $f1 ), "store can't find deleted $f1"; + throws_ok { $store->read_file( $f1 ) } qr/file/, + "store can't return contents for deleted $f1"; + + ok ! $store->has_file( $f2 ), "store can't find deleted $f2"; + throws_ok { $store->read_file( $f2 ) } qr/file/, + "store can't return contents for deleted $f2"; + + ok $store->has_file( $f3 ), "store can still find $f3 in parent dir"; + eq_or_diff $store->read_file( $f3 ), $content, + "store can return contents for $f3"; + + ok $store->has_file( $f3 ), "store can still find $f4 in grand parent dir"; + eq_or_diff $store->read_file( $f4 ), $content, + "store can return contents for $f4"; + }; + }; + + subtest 'verbose' => sub { + + local $ENV{MOJO_LOG_LEVEL} = 'debug'; + + subtest 'write' => sub { + my $tmpdir = tempdir; + my $store = $self->build( path => $tmpdir, ); + + my ( $out, $err, $exit ) = capture { + $store->write_file( 'path.html' => 'HTML' ); + }; + like $err, qr{\QWrite file: path.html}; + }; + + subtest 'read' => sub { + my $store + = $self->build( path => $self->share_dir->child( 'theme' ), ); + my $path = path( qw( blog post.html.ep ) ); + my ( $out, $err, $exit ) = capture { + $store->read_file( $path ); + }; + like $err, qr{\QRead file: $path}; + + }; + }; + +}; + +around run_tests => sub { + + my $orig = shift; + my $self = shift; + + $self->$orig( @_ ); + subtest file => sub { $self->$test_file }; +}; + +1; diff --git a/t/store/constructor.t b/t/store/constructor.t deleted file mode 100644 index 93db2a52..00000000 --- a/t/store/constructor.t +++ /dev/null @@ -1,26 +0,0 @@ -use Test::Lib; -use My::Test; -use Statocles::Store; -my $SHARE_DIR = path( __DIR__, '..', 'share' ); -my $site = build_test_site( theme => $SHARE_DIR->child( 'theme' ) ); - -test_constructor( - 'Statocles::Store', - required => { - path => $SHARE_DIR->child( qw( store docs ) ), - }, -); - -subtest 'warn if path does not exist' => sub { - my $path = $SHARE_DIR->child( qw( DOES_NOT_EXIST ) ); - lives_ok { - Statocles::Store->new( - path => $path, - )->read_documents; - } 'store created with nonexistent path'; - - cmp_deeply $site->log->history->[-1], [ ignore(), 'warn', qq{Store path "$path" does not exist} ] - or diag explain $site->log->history->[-1]; -}; - -done_testing; diff --git a/t/store/document.t b/t/store/document.t deleted file mode 100644 index 5163b9cf..00000000 --- a/t/store/document.t +++ /dev/null @@ -1,392 +0,0 @@ - -use Test::Lib; -use My::Test; -use Statocles::Store; -use Statocles::Util qw( dircopy ); -use Capture::Tiny qw( capture ); -use TestDocument; -my $SHARE_DIR = path( __DIR__, '..', 'share' ); -build_test_site( theme => $SHARE_DIR->child( 'theme' ) ); - -my $DT_FORMAT = '%Y-%m-%d %H:%M:%S'; - -sub expect_docs { - my ( $store ) = @_; - - return ( - Statocles::Document->new( - path => '/required.markdown', - title => 'Required Document', - author => 'preaction', - content => "No optional things in here, at all!\n", - store => $store, - ), - - Statocles::Document->new( - path => '/ext/short.md', - title => 'Short Extension', - content => "This is a short extension\n", - store => $store, - ), - - Statocles::Document->new( - path => '/no-frontmatter.markdown', - content => "\n# This Document has no frontmatter!\n\nDocuments are not required to have frontmatter!\n", - store => $store, - ), - - Statocles::Document->new( - path => '/path.markdown', - title => 'Document with path inside', - author => 'preaction', - content => "The path is in the file, and it must be ignored.\n", - store => $store, - ), - - Statocles::Document->new( - path => '/datetime.markdown', - title => 'Datetime Document', - author => 'preaction', - date => DateTimeObj->coerce( '2014-04-30 15:34:32' ), - content => "Parses date/time for date\n", - store => $store, - ), - - Statocles::Document->new( - path => '/date.markdown', - title => 'Date Document', - author => 'preaction', - date => DateTimeObj->coerce( '2014-04-30' ), - content => "Parses date only for date\n", - store => $store, - ), - - Statocles::Document->new( - path => '/links/alternate_single.markdown', - title => 'Linked Document', - author => 'preaction', - content => "This document has a single alternate link\n", - links => { - alternate => [ - { - title => 'blogs.perl.org', - href => 'http://blogs.perl.org/preaction/404.html', - }, - ], - }, - store => $store, - ), - - Statocles::Document->new( - path => '/tags/single.markdown', - title => 'Tagged (Single) Document', - author => 'preaction', - tags => [qw( single )], - content => "This document has a single tag\n", - store => $store, - ), - - Statocles::Document->new( - path => '/tags/array.markdown', - title => 'Tagged (Array) Document', - author => 'preaction', - tags => [ 'multiple', 'tags', 'in an', 'array' ], - content => "This document has multiple tags in an array\n", - store => $store, - ), - - Statocles::Document->new( - path => '/tags/comma.markdown', - title => 'Tagged (Comma) Document', - author => 'preaction', - tags => [ "multiple", "tags", "separated by", "commas" ], - content => "This document has multiple tags separated by commas\n", - store => $store, - ), - - - Statocles::Document->new( - path => '/template/basic.markdown', - title => 'Template document', - content => "This document has a template\n", - template => [qw( document basic.html.ep )], - layout => [qw( site basic.html.ep )], - store => $store, - ), - - Statocles::Document->new( - path => '/template/leading-slash.markdown', - title => 'Template (Slash) document', - content => "This document has a template with a leading slash\n", - template => [qw( document slash.html.ep )], - layout => [qw( site slash.html.ep )], - store => $store, - ), - - TestDocument->new( - path => '/class/test_document.markdown', - title => 'Test Class', - content => "This is a custom class\n", - store => $store, - ), - ); -} - -my $ignored_store = Statocles::Store->new( - path => $SHARE_DIR->child( qw( store docs ignore ) ), -); - -subtest 'read documents' => sub { - my $store = Statocles::Store->new( - path => $SHARE_DIR->child( qw( store docs ) ), - ); - cmp_deeply $store->documents, bag( expect_docs( $store ) ) or diag explain $store->documents; - - subtest 'clear documents' => sub { - # Edit the document - $store->documents->[0]->title( 'This is a new title' ); - # Clear all the documents - $store->clear; - # Re-read them from disk - cmp_deeply $store->documents, bag( expect_docs( $store ) ) or diag explain $store->documents; - }; -}; - -subtest 'parse frontmatter from content' => sub { - my $store = Statocles::Store->new( - path => tempdir, - ); - my $path = $SHARE_DIR->child( qw( store docs required.markdown ) ); - cmp_deeply - { $store->parse_frontmatter( $path, $path->slurp_utf8 ) }, - { - title => 'Required Document', - author => 'preaction', - content => "No optional things in here, at all!\n", - }; - - subtest 'does not warn without content' => sub { - my @warnings; - local $SIG{__WARN__} = sub { push @warnings, @_ }; - cmp_deeply - { $store->parse_frontmatter( 'UNDEF' ) }, - { }, - 'empty hashref'; - ok !@warnings, 'no warnings' or diag explain \@warnings; - }; - - subtest 'does not warn without more than one line' => sub { - my @warnings; - local $SIG{__WARN__} = sub { push @warnings, @_ }; - cmp_deeply - { $store->parse_frontmatter( 'one line', 'only one line' ) }, - { content => "only one line\n" }, - 'empty hashref'; - ok !@warnings, 'no warnings' or diag explain \@warnings; - }; - - subtest 'does not warn with only a newline' => sub { - my @warnings; - local $SIG{__WARN__} = sub { push @warnings, @_ }; - cmp_deeply - { $store->parse_frontmatter( 'newline', "\n" ) }, - { content => '' }, - 'empty hashref'; - ok !@warnings, 'no warnings' or diag explain \@warnings; - }; -}; - -subtest 'read with relative directory' => sub { - my $cwd = cwd; - chdir $SHARE_DIR; - my $store = Statocles::Store->new( - path => 'store/docs', - ); - cmp_deeply $store->documents, bag( expect_docs( $store ) ); - chdir $cwd; -}; - -subtest 'path that has regex-special characters inside' => sub { - my $tmpdir = tempdir; - my $baddir = $tmpdir->child( '[regex](name).dir' ); - dircopy $SHARE_DIR->child( qw( store docs ) ), $baddir; - my $ignored_store = Statocles::Store->new( - path => $baddir->child( qw( ignore ) ), - ); - my $store = Statocles::Store->new( - path => $baddir, - ); - cmp_deeply $store->documents, bag( expect_docs( $store ) ) - or diag join "\n", map { $_->path->stringify } @{ $store->documents }; -}; - -subtest 'bad documents' => sub { - subtest 'no ending frontmatter mark' => sub { - my $store = Statocles::Store->new( - path => $SHARE_DIR->child( qw( store error missing-end-mark ) ), - ); - my $from = $store->path->child( 'missing.markdown' )->relative( cwd )->stringify; - throws_ok { $store->documents } qr{\QCould not find end of front matter (---) in "$from"}; - }; - - subtest 'invalid yaml' => sub { - my $store = Statocles::Store->new( - path => $SHARE_DIR->child( qw( store error bad-yaml ) ), - ); - my $from = $store->path->child( 'bad.markdown' )->relative( cwd )->stringify; - throws_ok { $store->documents } qr{\QError parsing YAML in "$from"}; - }; - - subtest 'invalid date/time' => sub { - my $store = Statocles::Store->new( - path => $SHARE_DIR->child( qw( store error bad-dates ) ), - ); - my $from = $store->path->child( 'bad-date.markdown' )->relative( cwd )->stringify; - throws_ok { $store->documents } - qr{\QCould not parse date "11/12/2014" in "$from": Does not match "YYYY-MM-DD" or "YYYY-MM-DD HH:MM:SS"}; - }; - - subtest 'invalid links structure' => sub { - my $store = Statocles::Store->new( - path => $SHARE_DIR->child( qw( store error bad-links ) ), - ); - my $from = $store->path->child( 'links.markdown' )->relative( cwd )->stringify; - throws_ok { $store->documents } - qr{\QError creating document in "$from": Value "bad link" is not valid for attribute "links" (expected "LinkHash")}; - }; -}; - -subtest 'write document' => sub { - no warnings 'once'; - local $YAML::Indent = 4; # Ensure our test output matches our indentation level - my $tmpdir = tempdir; - my $store = Statocles::Store->new( - path => $tmpdir, - ); - my $tp = DateTimeObj->coerce( '2014-06-05 00:00:00' ); - my $dt = $tp->strftime( '%Y-%m-%d %H:%M:%S' ); - my $doc = { - foo => 'bar', - content => "# \x{2603} This is some content\n\nAnd a paragraph\n", - tags => [ 'one', 'two and three', 'four' ], - date => $tp, - }; - - subtest 'disallow absolute paths' => sub { - my $path = rootdir->child( 'example.markdown' ); - throws_ok { $store->write_document( $path => $doc ) } - qr{Cannot write document '$path': Path must not be absolute}; - }; - - subtest 'simple path' => sub { - my @warnings; - local $SIG{__WARN__} = sub { push @warnings, $_[0] }; - - $store->write_document( 'example.markdown' => $doc ); - cmp_deeply $store->read_document( 'example.markdown' ), - Statocles::Document->new( path => 'example.markdown', store => $store, %$doc ) - or diag explain $store->read_document( 'example.markdown' ); - my $full_path = $store->path->child( 'example.markdown' ); - eq_or_diff path( $full_path )->slurp_utf8, - $SHARE_DIR->child( qw( store write doc.markdown ) )->slurp_utf8; - - ok !@warnings, 'no warnings from write' - or diag "Got warnings: \n\t" . join "\n\t", @warnings; - }; - - subtest 'make the directories if necessary' => sub { - my @warnings; - local $SIG{__WARN__} = sub { push @warnings, $_[0] }; - - my $path = path(qw( blog 2014 05 28 example.markdown )); - $store->write_document( $path => $doc ); - cmp_deeply $store->read_document( $path ), Statocles::Document->new( path => $path, store => $store, %$doc ); - my $full_path = $tmpdir->child( $path ); - eq_or_diff path( $full_path )->slurp_utf8, - $SHARE_DIR->child( qw( store write doc.markdown ) )->slurp_utf8; - - ok !@warnings, 'no warnings from write' - or diag "Got warnings: \n\t" . join "\n\t", @warnings; - }; - - subtest 'allow Document objects' => sub { - my @warnings; - local $SIG{__WARN__} = sub { push @warnings, $_[0] }; - - my $doc_obj = Statocles::Document->new( - path => 'example.markdown', - store => $store, - %$doc, - ); - - $store->write_document( 'doc_obj.markdown' => $doc_obj ); - my $full_path = $store->path->child( 'doc_obj.markdown' ); - cmp_deeply $store->read_document( 'doc_obj.markdown' ), - Statocles::Document->new( path => 'doc_obj.markdown', store => $store, %$doc ) - or diag explain $store->read_document( 'doc_obj.markdown' ); - eq_or_diff path( $full_path )->slurp_utf8, - $SHARE_DIR->child( qw( store write doc_obj.markdown ) )->slurp_utf8; - - ok !@warnings, 'no warnings from write' - or diag "Got warnings: \n\t" . join "\n\t", @warnings; - }; - -}; - -subtest 'removing a store reveals formerly-ignored files' => sub { - $ignored_store = undef; - my $store = Statocles::Store->new( - path => $SHARE_DIR->child( qw( store docs ) ), - ); - my $ignored_doc = Statocles::Document->new( - path => '/ignore/ignored.markdown', - title => 'This document is ignored', - content => "This document is ignored because it's being used by another Store\n", - store => $store, - ); - cmp_deeply $store->documents, bag( expect_docs( $store ), $ignored_doc ) - or diag explain $store->documents; -}; - -subtest 'verbose' => sub { - - local $ENV{MOJO_LOG_LEVEL} = 'debug'; - - subtest 'write' => sub { - my $tmpdir = tempdir; - my $store = Statocles::Store->new( - path => $tmpdir, - ); - - my ( $out, $err, $exit ) = capture { - $store->write_document( 'path.markdown' => { foo => 'BAR' } ); - }; - like $err, qr{\QWrite document: path.markdown}; - }; - - subtest 'read' => sub { - - my $store = Statocles::Store->new( - path => $SHARE_DIR->child( qw( store docs ) ), - ); - my $path = path( qw( required.markdown ) ); - my ( $out, $err, $exit ) = capture { - $store->read_document( $path ); - }; - like $err, qr{\QRead document: $path}; - - }; - -}; - -subtest 'check if a path is a document' => sub { - my $store = Statocles::Store->new( - path => $SHARE_DIR->child( qw( store ) ), - ); - ok $store->is_document( Path::Tiny->new(qw( docs ext short.md )) ); - ok $store->is_document( join "/", qw( docs ext short.md ) ); - ok !$store->is_document( Path::Tiny->new( qw( files image.png ) ) ); - ok !$store->is_document( join "/", qw( files image.png ) ); -}; - -done_testing; diff --git a/t/store/file.t b/t/store/file.t deleted file mode 100644 index ff00abe8..00000000 --- a/t/store/file.t +++ /dev/null @@ -1,234 +0,0 @@ - -use Test::Lib; -use My::Test; -use Statocles::Store; -use Capture::Tiny qw( capture ); -my $SHARE_DIR = path( __DIR__, '..', 'share' ); -build_test_site( theme => $SHARE_DIR->child( 'theme' ) ); - -my $ignored_store = Statocles::Store->new( - path => $SHARE_DIR->child( qw( store files ignore ) ), -); - -subtest 'read files' => sub { - my $store = Statocles::Store->new( - path => $SHARE_DIR->child( qw( store files ) ), - ); - my $content = $store->read_file( path( 'text.txt' ) ); - eq_or_diff $SHARE_DIR->child( qw( store files text.txt ) )->slurp_utf8, $content; -}; - -subtest 'has file' => sub { - my $store = Statocles::Store->new( - path => $SHARE_DIR->child( qw( store files ) ), - ); - ok $store->has_file( path( 'text.txt' ) ); - ok !$store->has_file( path( 'missing.exe' ) ); -}; - -subtest 'find files' => sub { - my $store = Statocles::Store->new( - path => $SHARE_DIR->child( qw( store files ) ), - ); - my @expect_paths = ( - path( qw( text.txt ) )->absolute( '/' ), - path( qw( image.png ) )->absolute( '/' ), - ); - my @expect_docs = ( - path( qw( folder doc.markdown ) )->absolute( '/' ), - ); - - my $iter = $store->find_files; - my @got_paths; - while ( my $path = $iter->() ) { - push @got_paths, $path; - } - - cmp_deeply \@got_paths, bag( @expect_paths ) - or diag explain \@got_paths; - - subtest 'include documents' => sub { - my $iter = $store->find_files( include_documents => 1 ); - my @got_paths; - while ( my $path = $iter->() ) { - push @got_paths, $path; - } - - cmp_deeply \@got_paths, bag( @expect_paths, @expect_docs ) - or diag explain \@got_paths; - }; - - subtest 'can pass paths to read_file' => sub { - my ( $path ) = grep { $_->basename eq 'text.txt' } @got_paths; - eq_or_diff $store->read_file( $path ), - $SHARE_DIR->child( qw( store files text.txt ) )->slurp_utf8; - }; - -}; - -subtest 'write files' => sub { - - subtest 'string' => sub { - my @warnings; - local $SIG{__WARN__} = sub { push @warnings, $_[0] }; - - my $tmpdir = tempdir; - my $store = Statocles::Store->new( - path => $tmpdir, - ); - - my $content = "\x{2603} This is some plain text"; - - # write_file with string is written using UTF-8 - $store->write_file( path( qw( store files text.txt ) ), $content ); - - my $path = $tmpdir->child( qw( store files text.txt ) ); - eq_or_diff $path->slurp_utf8, $content; - - ok !@warnings, 'no warnings from write' - or diag "Got warnings: \n\t" . join "\n\t", @warnings; - }; - - subtest 'filehandle' => sub { - my $tmpdir = tempdir; - my $store = Statocles::Store->new( - path => $tmpdir, - ); - - subtest 'plain text files' => sub { - my @warnings; - local $SIG{__WARN__} = sub { push @warnings, $_[0] }; - - my $fh = $SHARE_DIR->child( qw( store files text.txt ) )->openr_raw; - - $store->write_file( path( qw( store files text.txt ) ), $fh ); - - my $path = $tmpdir->child( qw( store files text.txt ) ); - eq_or_diff $path->slurp_raw, $SHARE_DIR->child( qw( store files text.txt ) )->slurp_raw; - - ok !@warnings, 'no warnings from write' - or diag "Got warnings: \n\t" . join "\n\t", @warnings; - }; - - subtest 'images' => sub { - my @warnings; - local $SIG{__WARN__} = sub { push @warnings, $_[0] }; - - my $fh = $SHARE_DIR->child( qw( store files image.png ) )->openr_raw; - - $store->write_file( path( qw( store files image.png ) ), $fh ); - - my $path = $tmpdir->child( qw( store files image.png ) ); - ok $path->slurp_raw eq $SHARE_DIR->child( qw( store files image.png ) )->slurp_raw, - 'image content is correct'; - - ok !@warnings, 'no warnings from write' - or diag "Got warnings: \n\t" . join "\n\t", @warnings; - }; - - }; - - subtest 'Path::Tiny object' => sub { - my $tmpdir = tempdir; - my $store = Statocles::Store->new( - path => $tmpdir, - ); - - subtest 'plain text files' => sub { - my @warnings; - local $SIG{__WARN__} = sub { push @warnings, $_[0] }; - - my $source_path = $SHARE_DIR->child( qw( store files text.txt ) ); - - $store->write_file( path( qw( store files text.txt ) ), $source_path ); - - my $dest_path = $tmpdir->child( qw( store files text.txt ) ); - eq_or_diff $dest_path->slurp_raw, $source_path->slurp_raw; - - ok !@warnings, 'no warnings from write' - or diag "Got warnings: \n\t" . join "\n\t", @warnings; - }; - - subtest 'images' => sub { - my @warnings; - local $SIG{__WARN__} = sub { push @warnings, $_[0] }; - - my $source_path = $SHARE_DIR->child( qw( store files image.png ) ); - - $store->write_file( path( qw( store files image.png ) ), $source_path ); - - my $dest_path = $tmpdir->child( qw( store files image.png ) ); - ok $dest_path->slurp_raw eq $source_path->slurp_raw, - 'image content is correct'; - - ok !@warnings, 'no warnings from write' - or diag "Got warnings: \n\t" . join "\n\t", @warnings; - }; - - }; -}; - -subtest 'remove' => sub { - - subtest 'file' => sub { - my $tmpdir = tempdir; - my $file_path = $tmpdir->child( 'foo', 'bar', 'baz.txt' ); - $file_path->parent->mkpath; - $file_path->spew( 'Hello'); - - my $store = Statocles::Store->new( - path => $tmpdir, - ); - $store->remove( path( qw( foo bar baz.txt ) ) ); - - ok !$file_path->exists, 'file has been removed'; - ok $file_path->parent->exists, 'parent dir is not removed'; - }; - - subtest 'directory' => sub { - my $tmpdir = tempdir; - my $file_path = $tmpdir->child( 'foo', 'bar', 'baz.txt' ); - $file_path->parent->mkpath; - $file_path->spew( 'Hello'); - - my $store = Statocles::Store->new( - path => $tmpdir, - ); - $store->remove( path( qw( foo bar ) ) ); - - ok !$file_path->exists, 'file has been removed'; - ok !$file_path->parent->exists, 'parent dir is removed'; - ok $file_path->parent->parent->exists, 'grandparent dir is not removed'; - }; -}; - -subtest 'verbose' => sub { - - local $ENV{MOJO_LOG_LEVEL} = 'debug'; - - subtest 'write' => sub { - my $tmpdir = tempdir; - my $store = Statocles::Store->new( - path => $tmpdir, - ); - - my ( $out, $err, $exit ) = capture { - $store->write_file( 'path.html' => 'HTML' ); - }; - like $err, qr{\QWrite file: path.html}; - }; - - subtest 'read' => sub { - my $store = Statocles::Store->new( - path => $SHARE_DIR->child( 'theme' ), - ); - my $path = path( qw( blog post.html.ep ) ); - my ( $out, $err, $exit ) = capture { - $store->read_file( $path ); - }; - like $err, qr{\QRead file: $path}; - - }; -}; - -done_testing; diff --git a/t/store/store.t b/t/store/store.t new file mode 100644 index 00000000..7247a27a --- /dev/null +++ b/t/store/store.t @@ -0,0 +1,37 @@ +package My::Test::Statocles::Store; + +use Test::Lib; +use My::Test; + +use My::Test::Store; + +my $SHARE_DIR = path( __DIR__, '..', 'share' ); + +use Moo; + +with 'My::Test::Store'; + +has '+class' => ( is => 'ro', + default => 'Statocles::Store' + ); + +has '+share_dir' => ( is => 'ro', + default => sub { $SHARE_DIR } + ); + + +sub args { + my $self = shift; + return { @_ }; +} + +sub required { + + return args( @_ ); +} + +__PACKAGE__->new->run_tests; + + +done_testing; + diff --git a/t/store/tar.t b/t/store/tar.t new file mode 100644 index 00000000..f04b944e --- /dev/null +++ b/t/store/tar.t @@ -0,0 +1,77 @@ +package My::Test::Statocles::Store::Archive::Tar; + +use Test::Lib; +use My::Test; + +use My::Test::Store; +use Storable 'dclone'; + +my $SHARE_DIR = path( __DIR__, '..', 'share' ); + +use Archive::Tar; + +my %default_args; + +$default_args{archive_root} = $SHARE_DIR; +$default_args{archive_strip} = $default_args{archive_root}->relative( cwd ); + +my $archive = Archive::Tar->new; +$default_args{archive_root}->relative( cwd )->visit( + sub { + $archive->add_files( $_[0] ) if $_[0]->is_file; + }, + { recurse => 1 }, +); + +use Moo; + +with 'My::Test::Store'; + +has '+class' => ( is => 'ro', + default => 'Statocles::Store::Archive::Tar' + ); + +has '+share_dir' => ( is => 'ro', + default => sub { $SHARE_DIR } + ); + + +sub args { + + my $self = shift; + + my %arg = ( %default_args, @_ ); + + my $path = path( $arg{path} ); + $path = $path->realpath if $path->exists; + my $archive_root = $arg{archive_root}->realpath; + + # sometimes the test path is not a subdirectory of $SHARE_DIR, + # indicating that it is doing something which doesn't use the + # provided documents. Create an empty archive for the test to + # play with. + + unless ( $archive_root->subsumes( $path ) ) { + $arg{archive_root} = $arg{path}; + $arg{archive} = Archive::Tar->new; + } + else { + $arg{archive} = dclone( $archive ); + } + + return \%arg; +} + +sub required { + + my $self = shift; + my $args = $self->args( @_ ); + + delete $args->{archive_strip}; + + return $args; +} + +__PACKAGE__->new->run_tests; + +done_testing;