diff --git a/lib/Statocles/Store.pm b/lib/Statocles/Store.pm index 2cdc37ae..52073d88 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 @@ -121,24 +121,28 @@ 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; } +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! @@ -164,7 +168,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 ( $@ ) { @@ -257,7 +261,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."; @@ -298,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 @@ -308,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 ) @@ -336,7 +354,14 @@ object or undef if no files remain. It is used by L. sub files { my ( $self ) = @_; - return $self->path->iterator({ recurse => 1 }); + my $iter = $self->path->iterator({ recurse => 1, follow_symlinks => 1 }); + + sub { + while( my $path = $iter->() ) { + return $path if $path->is_file; + } + return; + } } @@ -366,7 +391,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; @@ -376,31 +400,31 @@ sub find_files { }; } -=method open_file +=method write_file - my $fh = $store->open_file( $path ) + $store->write_file( $path, $content ); -Open the file with the given path. Returns a filehandle. +Write the given C to the given C. This is mostly used to write +out L. -The filehandle opened is using raw bytes, not UTF-8 characters. +C may be a: -=cut +=over -sub open_file { - my ( $self, $path ) = @_; - return $self->path->child( $path )->openr_raw; -} +=item * -=method write_file +a simple string, which will be written using UTF-8 characters. - $store->write_file( $path, $content ); +=item * -Write the given C to the given C. This is mostly used to write -out L. +a L object whose C method will be used to +write it; + +=item * + +a filehandle which will be read from with no special encoding. -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. +=back =cut 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 6c135696..00000000 --- a/t/store/file.t +++ /dev/null @@ -1,244 +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 '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 { - 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;