flesh out model

lib/LibreCat.pm

@@ -4,6 +4,7 @@ use Catmandu::Sane;
 use Catmandu::Util qw(require_package);
 use String::CamelCase qw(camelize);
 use Data::Util qw(install_subroutine);
+use POSIX qw(strftime);
 use LibreCat::Layers;
 use LibreCat::Hook;
 use Catmandu;
@@ -52,6 +53,11 @@ sub import {
     }
 }
 
+# TODO this duplicates LibreCat::Logger
+sub log {
+    state $log = Log::Log4perl::get_logger($_[0]);
+}
+
 sub models {
     [qw(publication department research_group user project)];
 }
@@ -67,10 +73,12 @@ sub install_models {
             = require_package('LibreCat::Validator::JSONSchema');
         my $validator
             = $validator_pkg->new(schema => $self->config->{schemas}{$name});
-        my $model = $pkg->new(
-            bag        => Catmandu->store('main')->bag($name),
-            search_bag => Catmandu->store('search')->bag($name),
-            validator  => $validator,
+        my $update_fixer = $self->fixer("update_${name}.fix");
+        my $model        = $pkg->new(
+            bag               => Catmandu->store('main')->bag($name),
+            search_bag        => Catmandu->store('search')->bag($name),
+            validator         => $validator,
+            append_before_add => [update_fixer => $update_fixer],
             %$config,
         );
         install_subroutine($self, $name => sub {$model});
@@ -104,11 +112,38 @@ sub hook {
     };
 }
 
+sub fixer {
+    my ($self, $file) = @_;
+
+    $self->log->debug("searching for fix '$file'");
+
+    for my $path (@{$self->layers->fixes_paths}) {
+        $self->log->debug("testing '$path/$file'");
+        if (-r "$path/$file") {
+            $self->log->debug("found '$path/$file'");
+            return Catmandu::Fix->new(fixes => ["$path/$file"]);
+        }
+    }
+
+    $self->log->error("can't find a fixer for '$file'");
+
+    # TODO this should throw an error and not be called at all if there is no
+    # fix
+    Catmandu::Fix->new;
+}
+
 sub searcher {
     state $searcher = require_package('LibreCat::Search')
         ->new(store => Catmandu->store('search'));
 }
 
+sub timestamp {
+    my $time = $_[1] // time;
+    my $time_format = $_[0]->config->{time_format} // '%Y-%m-%dT%H:%M:%SZ';
+    my $now = strftime($time_format, gmtime($time));
+    $now;
+}
+
 1;
 
 __END__

lib/LibreCat/App/Helper.pm

@@ -221,7 +221,7 @@ sub all_marked {
 }
 
 sub get_publication {
-    $_[0]->publication->get($_[1]);
+    LibreCat->publication->get($_[1]);
 }
 
 # TODO clean this up
@@ -242,12 +242,12 @@ sub get_person {
 }
 
 sub get_project {
-    $_[0]->project->get($_[1]);
+    LibreCat->project->get($_[1]);
 }
 
 sub get_department {
     if ($_[1] && length $_[1]) {
-        $_[0]->department->get($_[1]);
+        LibreCat->department->get($_[1]);
     }
 }
 

lib/LibreCat/Model.pm

@@ -1,80 +1,150 @@
 package LibreCat::Model;
 
 use Catmandu::Sane;
+use Catmandu::Util qw(is_string is_code_ref is_able);
+use List::Util qw(pairs);
 use Moo::Role;
 use namespace::clean;
 
 with 'LibreCat::Logger';
 
-has bag => (is => 'ro', required => 1, handles => [qw(generate_id)]);
-has search_bag => (is => 'ro', required => 1);
-has validator => (is => 'ro', required => 1, handles => [qw(is_valid)]);
+has bag => (is => 'ro', required => 1, handles => 'Catmandu::Iterable');
+has search_bag =>
+    (is => 'ro', required => 1, handles => [qw(search searcher)]);
+has validator =>
+    (is => 'ro', required => 1, handles => [qw(is_valid whitelist)]);
+has before_add => (is => 'lazy');
+
+sub _build_before_add {
+    [whitelist => 'apply_whitelist'];
+}
+
+sub prepend_before_add {
+    my $self = shift;
+    unshift @{$self->before_add}, @_;
+}
+
+sub append_before_add {
+    my $self = shift;
+    push @{$self->before_add}, @_;
+}
+
+sub BUILD {
+    my ($self, $opts) = @_;
+    for my $method (qw(prepend_before_add append_before_add)) {
+        if (my $hooks = $opts->{$method}) {
+            $self->$method(@$hooks);
+        }
+    }
+}
+
+sub generate_id {
+    $_[0]->bag->generate_id;
+}
 
 sub get {
     my ($self, $id) = @_;
-
     $self->bag->get($id);
 }
 
+sub add_many {
+    my ($self, $recs, %opts) = @_;
+    $recs->each(
+        sub {
+            $self->add($_[0], %opts, skip_commit => 1);
+        }
+    );
+    $self->bag->commit;
+    $self->search_bag->commit;
+
+    # TODO return value
+}
+
 sub add {
-    my ($self, $rec) = @_;
+    my ($self, $rec, %opts) = @_;
 
-    $rec = $self->prepare($rec);
+    # TODO do we really need an id even before validation?
+    $rec->{_id} //= $self->generate_id;
+
+    $rec = $self->apply_hooks_to_record($self->before_add, $rec,
+        skip => $opts{skip_before_add});
 
     if ($self->is_valid($rec)) {
-        $self->_store($rec);
-        $self->_index($rec);
+        $self->_store($rec, %opts);
+        $self->_index($rec, %opts);
+    }
+    elsif ($opts{on_validation_error}) {
+        $opts{on_validation_error}->($rec);
     }
 
     $rec;
 }
 
 sub delete {
-    my ($self, $id) = @_;
-    return unless $self->get($id);
-    $self->_purge($id);
+    my ($self, $id, %opts) = @_;
+    $self->purge($id, %opts);
 }
 
 sub _store {
-    my ($self, $rec) = @_;
+    my ($self, $rec, %opts) = @_;
 
-    $rec = $self->bag->add($rec);
-    $rec = $self->_index($rec);
-
-    $rec;
+    $self->bag->add($rec);
+    $self->bag->commit unless $opts{skip_commit};
 }
 
 sub _index {
-    my ($self, $rec) = @_;
+    my ($self, $rec, %opts) = @_;
+
+    if ($self->log->is_debug) {
+        my $bag_name = $self->search_bag->name;
+        $self->log->debugf("indexing record in %s: %s", $bag_name, $rec);
+    }
 
     $rec = $self->search_bag->add($rec);
-    $self->search_bag->commit;
+    $self->search_bag->commit unless $opts{skip_commit};
+
+    sleep 1 unless $opts{skip_commit};    # TODO move to controller
 
     $rec;
 }
 
-sub _purge {
-    my ($self, $id) = @_;
+sub purge {
+    my ($self, $id, %opts) = @_;
+
+    return unless $self->get($id);
 
     $self->bag->delete($id);
-    $self->bag->commit;
+    $self->bag->commit unless $opts{skip_commit};
 
     $self->search_bag->delete($id);
-    $self->search_bag->commit;
+    $self->search_bag->commit unless $opts{skip_commit};
+
+    sleep 1 unless $opts{skip_commit};    # TODO move to controller
 
     $id;
 }
 
-sub prepare {
-    my ($self, $rec) = @_;
-    $self->_apply_whitelist($rec);
+# TODO compile this
+sub apply_hooks_to_record {
+    my ($self, $hooks, $rec, %opts) = @_;
+
+    for my $pair (pairs @$hooks) {
+        my ($name, $hook) = @$pair;
+        next if $opts{skip} && grep {$_ eq $name} @{$opts{skip}};
+        if (is_string($hook)) {
+            $rec = $self->$hook($rec);
+        }
+        elsif (is_able($hook, 'fix')) {
+            $rec = $hook->fix($rec);
+        }
+    }
+
     $rec;
 }
 
-sub _apply_whitelist {
+sub apply_whitelist {
     my ($self, $rec) = @_;
-    my $validator = $self->validator;
-    my $whitelist = $validator->whitelist;
+    my $whitelist = $self->whitelist;
     for my $key (keys %$rec) {
         unless (grep {$_ eq $key} @$whitelist) {
             $self->log->debug("deleting invalid key: $key");

lib/LibreCat/Model/Publication.pm

@@ -1,9 +1,57 @@
 package LibreCat::Model::Publication;
 
 use Catmandu::Sane;
+use LibreCat;
+use LibreCat::App::Catalogue::Controller::File     ();
+use LibreCat::App::Catalogue::Controller::Material ();
+use Catmandu::Fix::add_citation;
 use Moo;
 use namespace::clean;
 
 with 'LibreCat::Model';
 
+sub BUILD {
+    my ($self) = @_;
+    $self->append_before_add(
+
+        # TODO this is very dirty and executes even if validation fails
+        file             => '_store_file',
+        related_material => '_store_related_material',
+
+        # TODO move to config
+        citation => Catmandu::Fix::add_citation->new,
+    );
+}
+
+sub delete {
+    my ($self, $id) = @_;
+
+    my $rec = $self->get($id) || return;
+
+    if ($rec->{oai_deleted} || $rec->{status} eq 'public') {
+        $rec->{oai_deleted} = 1;
+        $rec->{locked}      = 1;
+    }
+
+    $rec->{date_deleted} = LibreCat->timestamp;
+    $rec->{status}       = 'deleted';
+
+    $self->add($rec);
+}
+
+sub _store_file {
+    my ($self, $rec) = @_;
+    LibreCat::App::Catalogue::Controller::File::handle_file($rec);
+    $rec;
+}
+
+sub _store_related_material {
+    my ($self, $rec) = @_;
+    if ($rec->{related_material}) {
+        LibreCat::App::Catalogue::Controller::Material::update_related_material(
+            $rec);
+    }
+    $rec;
+}
+
 1;