package App::WRT::EntryStore; use strict; use warnings; use 5.10.0; use File::Find; use Carp; =pod =head1 NAME App::WRT::EntryStore - model the contents of a wrt repo's entry_dir =head1 SYNOPSIS use App::WRT::EntryStore; my $entries = App::WRT::EntryStore->new('./archives'); my @all = $entries->all(); my @months = $entries->all_months(); my @years = $entries->all_years(); my @days = $entries->all_days(); # all_* are wrappers for dates_by_depth(): my @days = $entries->dates_by_depth( 3 # 1 for years, 2 for months, 3 for days ); my @recent_days = $entries->recent_days(30); my @recent_months = $entries->recent_months(12); my @recent_years = $entries->recent_years(10); # recent_* are wrappers for recent_by_depth(): my @recent_days $entries->recent_by_depth( 3, # 1 for years, 2 for months, 3 for days 30 # count ); =head1 METHODS =over =item new($class, $entry_dir) Get a new EntryStore, using a given $entry_dir. Finds a list of entries for the given directory, and builds data structures which can be used to index into entries by depth, property, and next/previous entry. =cut my $ENTRYTYPE_FILE = 0; my $ENTRYTYPE_DIR = 1; sub new { my $class = shift; my ($entry_dir) = @_; my %params = ( entry_dir => $entry_dir ); my $self = \%params; bless $self, $class; my @entries; my %source_files; my %entry_properties; my %property_entries; find( sub { # We skip index files, because they'll be rendered from the dir path: return unless $File::Find::name =~ m{^ \Q$entry_dir\E / (.*) $}x; my $target = $1; # Build an ordered array of entries: push @entries, $target; # Build a hash indicating: # a. that a file exists # b. whether it's a flatfile or a directory if (-f $_) { $source_files{$target} = $ENTRYTYPE_FILE; } elsif (-d $_) { $source_files{$target} = $ENTRYTYPE_DIR; } # Build hashes of all properties of entries, and all entries of properties: if ($target =~ m{(.*) / (.*) [.]prop $}x) { my ($entry, $property) = ($1, $2); $entry_properties{$entry} //= []; push @{ $entry_properties{$entry} }, $property; $property_entries{$property} //= []; push @{ $property_entries{$property} }, $entry; } }, $entry_dir ); # Stash refs for future use: $self->{entries} = \@entries; $self->{source_files} = \%source_files; $self->{property_entries} = \%property_entries; $self->{entry_properties} = \%entry_properties; $self->generate_date_hashes(); return $self; } =item all() Returns a list of all source files for the current entry archive (excepting index files, which are a special case - this part could use some work). This was originally in App::WRT::Renderer, so there may be some pitfalls here. =cut sub all { my ($self) = shift; return @{ $self->{entries} }; } =item dates_by_depth($depth) Returns a sorted list of all date-like entries which are at a specified depth. Use 1 for years, 2 for months, and 3 for days. Fairly silly, but entertaining in its perverse way. all_years(), all_months(), and all_days() are provided for convenience. =cut sub dates_by_depth { my ($self) = shift; my ($depth) = @_; if (! defined $depth) { croak('No $depth given.'); } # Check if we already have a value cached: return @{ $self->{by_depth}->{$depth} } if defined $self->{by_depth}->{$depth}; # Build a pattern for matching the given depth of date-like entries. For # example, a day would be depth 3, and matched by \d+/\d+/\d+ my @particles; for (my $i = 0; $i < $depth; $i++) { push @particles, '\d+'; } my $pattern = join '/', @particles; # Sort entries matching the above pattern by converting them to an array with # an easily sortable string format as the second value, like [ "2014/1/1", # "201400010001" ], sorting these arrayrefs by that value, and then # re-mapping them to the original values. # # See here: https://en.wikipedia.org/wiki/Schwartzian_transform my @by_depth = map { $_->[0] } sort { $a->[1] cmp $b->[1] } map { [$_, sortable_date_from_entry($_)] } grep m{^ $pattern $}x, $self->all(); # Stash arrayref for future use: $self->{by_depth}->{$depth} = \@by_depth; return @by_depth; } sub sortable_date_from_entry { my ($entry) = @_; my @parts = map { sprintf("%4d", $_) } split '/', $entry; return join '', @parts; } =item all_years(), all_months(), all_days() Convenience wrappers for dates_by_depth(). =cut sub all_years { return $_[0]->dates_by_depth(1); } sub all_months { return $_[0]->dates_by_depth(2); } sub all_days { return $_[0]->dates_by_depth(3); } =item days_for($month), months_for($year) Convenience wrappers for extracting days or months in a given month or year. =cut sub days_for { my ($self, $container) = @_; return grep { m{^ \Q$container\E / }x } $self->all_days(); } sub months_for { my ($self, $year) = @_; return grep { m{^ \Q$year\E / }x } $self->all_months(); } =item recent_by_depth($depth, $entry_count) Returns the $entry_count most recent dated entries at $depth (1 for year, 2 for month, 3 for day). recent_years(), recent_months(), and recent_days() are provided for convenience. =cut sub recent_by_depth { my ($self) = shift; my ($depth, $entry_count) = @_; my @entries; for my $entry (reverse $self->dates_by_depth($depth)) { last if scalar(@entries) == $entry_count; push @entries, $entry; } return @entries; } =item all_years(), all_months(), all_days() Convenience wrappers for recent_by_depth(). =cut sub recent_years { return $_[0]->recent_by_depth(1, $_[1]); } sub recent_months { return $_[0]->recent_by_depth(2, $_[1]); } sub recent_days { return $_[0]->recent_by_depth(3, $_[1]); } =item generate_date_hashes() Store hashes which map dated entries to their previous and next entries at the same depth in the tree. That is, something like: %prev_dates = { '2014' => '2013', '2014/1' => '2013/12' '2014/1/1' => '2013/12/30', ... } %next_dates = { '2013' => '2014', '2013/12' => '2014/1', '2013/12/30' => '2014/1/1', ... } =cut sub generate_date_hashes { my $self = shift; my %prev; # Depth 1 is years, 2 is months, 3 is days. Get lists for all: for my $depth (1, 2, 3) { my @dates = $self->dates_by_depth($depth); my $last_seen; foreach my $current_date (@dates) { if ($last_seen) { $prev{$current_date} = $last_seen; } $last_seen = $current_date; } } $self->{prev_dates} = { %prev }; $self->{next_dates} = { reverse %prev }; } =item parent($entry) Return an entry's parent, or undef if it's at the top level. =cut sub parent { my $self = shift; my ($entry) = @_; # Explode unless an entry actually exists in the archives: croak("No such entry: $entry") unless $self->is_extant($entry); my (@components) = split '/', $entry; pop @components; if (@components) { return join '/', @components; } return undef; } =item children($entry) Return an entry's (immediate) children. =cut sub children { my $self = shift; my ($entry) = @_; # Explode unless an entry actually exists in the archives: croak("No such entry: $entry") unless $self->is_extant($entry); # A cheesy regexp solution to this problem: return grep { m{^ \Q$entry\E / [^/]+ $}x } $self->all(); } =item previous($entry) Return the previous entry at the same depth for the given entry. =cut sub previous { return $_[0]->{prev_dates}->{ $_[1] }; } =item next($entry) Return the next entry at the same depth for the given entry. =cut sub next { return $_[0]->{next_dates}->{ $_[1] }; } =item by_prop($property) Return an array of any entries for the given property. =cut sub by_prop { my ($self, $property) = @_; my @entries; if (defined $self->{property_entries}{$property}) { @entries = @{ $self->{property_entries}{$property} }; } return @entries; } =item props_for($entry) Return an array of any properties for the given entry. =cut sub props_for { my ($self, $entry) = @_; my @props; if (defined $self->{entry_properties}{$entry}) { @props = @{ $self->{entry_properties}{$entry} }; } return @props; } =item has_prop($entry, $prop) Return 1 if the given entry has the given property. =cut sub has_prop { my ($self, $entry, $prop) = @_; my @props = grep { $_ eq $prop } $self->props_for($entry); return (@props == 1); } =item all_props() Return an array of all properties. =cut sub all_props { my $self = shift; return sort keys %{ $self->{property_entries} }; } =item is_extant($entry) Check if a given entry exists. =cut sub is_extant { my ($self, $entry) = @_; return exists($self->{source_files}{$entry}); } =item is_dir($entry) Check if an entry is a directory. =cut sub is_dir { my ($self, $entry) = @_; croak("No such entry: $entry") unless $self->is_extant($entry); return ($self->{source_files}{$entry} == $ENTRYTYPE_DIR); } =item is_file($entry) Check if an entry is a flatfile. =cut sub is_file { my ($self, $entry) = @_; croak("No such entry: $entry") unless $self->is_extant($entry); return ($self->{source_files}{$entry} == $ENTRYTYPE_FILE); } =item has_index($entry) Check if an entry contains an index file. TODO: Should this care about the pathological(?) case where index is a directory? =cut sub has_index { my ($self, $entry) = @_; croak("No such entry: $entry") unless $self->is_extant($entry); return $self->is_extant($entry . '/index'); } =item basename($entry) Get a base name (i.e., filename without path) for a given entry. =cut sub basename { my ($self, $entry) = @_; my @parts = split '/', $entry; return pop @parts; } =back =cut 1;