Bug 30708: Add Koha Objects

Sponsored-by: BULAC - http://www.bulac.fr/

Signed-off-by: BULAC - http://www.bulac.fr/
Signed-off-by: Heather Hernandez <heather_hernandez@nps.gov>
Signed-off-by: Laurence Rault <laurence.rault@biblibre.com>

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>

Koha/Exceptions/Preservation.pm

@@ -0,0 +1,83 @@
+package Koha::Exceptions::Preservation;
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+
+use Koha::Exception;
+
+use Exception::Class (
+
+    'Koha::Exceptions::Preservation' => {
+        isa => 'Koha::Exception',
+    },
+    'Koha::Exceptions::Preservation::MissingSettings' => {
+        isa         => 'Koha::Exceptions::Preservation',
+        description => "Missing configuration settings",
+        fields      => ['parameter'],
+    },
+    'Koha::Exceptions::Preservation::ItemAlreadyInTrain' => {
+        isa         => 'Koha::Exceptions::Preservation',
+        description => "Cannot add item to waiting list, it is already in a non-received train",
+    },
+    'Koha::Exceptions::Preservation::ItemNotInWaitingList' => {
+        isa         => 'Koha::Exceptions::Preservation',
+        description => "Cannot add item to train, it is not in the waiting list",
+    },
+    'Koha::Exceptions::Preservation::ItemNotFound' => {
+        isa         => 'Koha::Exceptions::Preservation',
+        description => "Cannot add item to train, the item does not exist",
+    },
+);
+
+sub full_message {
+    my $self = shift;
+
+    my $msg = $self->message;
+
+    unless ( $msg ) {
+        if ( $self->isa('Koha::Exceptions::Preservation::MissingSettings') ) {
+            $msg = sprintf("The following parameter settings is required: %s", $self->parameter );
+        }
+    }
+
+    return $msg;
+}
+
+=head1 NAME
+
+Koha::Exceptions::Preservation - Exception class for the preservation module
+
+=head1 Exceptions
+
+=head2 Koha::Exceptions::Preservation
+
+Generic Preservation exception
+
+=head2 Koha::Exceptions::Preservation::MissingSettings
+
+Exception to be used when the preservation module is not configured correctly
+and a setting is missing
+
+=head1 Class methods
+
+=head2 full_message
+
+Overloaded method for exception stringifying.
+
+=cut
+
+1;

Koha/Preservation/Processing.pm

@@ -0,0 +1,72 @@
+package Koha::Preservation::Processing;
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+
+use Koha::Database;
+
+use base qw(Koha::Object);
+
+use Koha::Preservation::Processing::Attributes;
+
+=head1 NAME
+
+Koha::Preservation::Processing - Koha Processing Object class
+
+=head1 API
+
+=head2 Class methods
+
+=cut
+
+=head3 attributes
+
+Set or return the attributes for this processing
+
+=cut
+
+sub attributes {
+    my ( $self, $attributes ) = @_;
+
+    if ( $attributes ) {
+        my $schema = $self->_result->result_source->schema;
+        $schema->txn_do(
+            sub {
+                $self->attributes->delete;
+
+                for my $attribute (@$attributes) {
+                    $self->_result->add_to_preservation_processing_attributes($attribute);
+                }
+            }
+        );
+    }
+
+    my $attributes_rs = $self->_result->preservation_processing_attributes;
+    return Koha::Preservation::Processing::Attributes->_new_from_dbic($attributes_rs);
+}
+
+=head2 Internal methods
+
+=head3 _type
+
+=cut
+
+sub _type {
+    return 'PreservationProcessing';
+}
+
+1;

Koha/Preservation/Processing/Attribute.pm

@@ -0,0 +1,44 @@
+package Koha::Preservation::Processing::Attribute;
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+
+use Koha::Database;
+
+use base qw(Koha::Object);
+
+=head1 NAME
+
+Koha::Preservation::Processing::Attribute - Koha Processing Attribute Object class
+
+=head1 API
+
+=head2 Class Methods
+
+=cut
+
+=head2 Internal methods
+
+=head3 _type
+
+=cut
+
+sub _type {
+    return 'PreservationProcessingAttribute';
+}
+
+1;

Koha/Preservation/Processing/Attributes.pm

@@ -0,0 +1,53 @@
+package Koha::Preservation::Processing::Attributes;
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+
+
+use Koha::Database;
+
+use Koha::Preservation::Processing::Attribute;
+
+use base qw(Koha::Objects);
+
+=head1 NAME
+
+Koha::Preservation::Processing::Attributes - Koha Processing Attribute Object set class
+
+=head1 API
+
+=head2 Class Methods
+
+=cut
+
+=head3 type
+
+=cut
+
+sub _type {
+    return 'PreservationProcessingAttribute';
+}
+
+=head3 object_class
+
+=cut
+
+sub object_class {
+    return 'Koha::Preservation::Processing::Attribute';
+}
+
+1;

Koha/Preservation/Processings.pm

@@ -0,0 +1,52 @@
+package Koha::Preservation::Processings;
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+
+use Koha::Database;
+
+use Koha::Preservation::Processing;
+
+use base qw(Koha::Objects);
+
+=head1 NAME
+
+Koha::Preservation::Processings - Koha Processing Object set class
+
+=head1 API
+
+=head2 Class Methods
+
+=cut
+
+=head3 type
+
+=cut
+
+sub _type {
+    return 'PreservationProcessing';
+}
+
+=head3 object_class
+
+=cut
+
+sub object_class {
+    return 'Koha::Preservation::Processing';
+}
+
+1;

Koha/Preservation/Train.pm

@@ -0,0 +1,133 @@
+package Koha::Preservation::Train;
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+
+use JSON qw( to_json );
+use Try::Tiny;
+
+use Koha::Database;
+
+use base qw(Koha::Object);
+
+use Koha::Preservation::Processings;
+use Koha::Preservation::Train::Items;
+
+use Koha::Exceptions::Preservation;
+
+=head1 NAME
+
+Koha::Preservation::Train - Koha Train Object class
+
+=head1 API
+
+=head2 Class methods
+
+=cut
+
+=head3 default_processing
+
+Return the default processing object for this train
+
+=cut
+
+sub default_processing {
+    my ( $self ) = @_;
+    my $rs = $self->_result->default_processing;
+    return unless $rs;
+    return Koha::Preservation::Processing->_new_from_dbic($rs);
+}
+
+=head3 add_item
+
+Add item to this train
+
+my $train_item = $train->add_item({item_id => $itemnumber, processing_id => $processing_id});
+my $train_item = $train->add_item({barcode => $barcode, processing_id => $processing_id});
+
+=cut
+
+sub add_item {
+    my ( $self, $train_item ) = @_;
+
+    my $not_for_loan = C4::Context->preference('PreservationNotForLoanWaitingListIn');
+
+    my $key  = exists $train_item->{item_id} ? 'itemnumber' : 'barcode';
+    my $item = Koha::Items->find( { $key => $train_item->{item_id} || $train_item->{barcode} } );
+    Koha::Exceptions::Preservation::ItemNotFound->throw unless $item;
+    Koha::Exceptions::Preservation::ItemNotInWaitingList->throw if $item->notforloan != $not_for_loan;
+
+    my $train_item_rs = $self->_result->add_to_preservation_trains_items(
+        {
+            item_id       => $item->itemnumber,
+            processing_id => $train_item->{processing_id} || $self->default_processing_id,
+            added_on      => \'NOW()',
+        }
+    );
+    $item->notforloan( $self->not_for_loan )->store;
+    return Koha::Preservation::Train::Item->_new_from_dbic($train_item_rs);
+}
+
+=head3 add_items
+
+my $train_items = $train->add_items([$item_1, $item_2]);
+
+Add items in batch.
+
+=cut
+
+sub add_items {
+    my ( $self, $train_items ) = @_;
+    my @added_items;
+    for my $train_item (@$train_items) {
+        try {
+            push @added_items, $self->add_item($train_item);
+        } catch {
+
+            # FIXME Do we rollback and raise an error or just skip it?
+            # FIXME See status code 207 partial success
+            warn "Item not added to train: " . $_;
+        };
+    }
+    return Koha::Preservation::Train::Items->search( { train_item_id => [ map { $_->train_item_id } @added_items ] } );
+}
+
+=head3 items
+
+my $items = $train->items;
+
+Return the items in this train.
+
+=cut
+
+sub items {
+    my ( $self ) = @_;
+    my $items_rs = $self->_result->preservation_trains_items;
+    return Koha::Preservation::Train::Items->_new_from_dbic($items_rs)
+}
+
+=head2 Internal methods
+
+=head3 _type
+
+=cut
+
+sub _type {
+    return 'PreservationTrain';
+}
+
+1;

Koha/Preservation/Train/Item.pm

@@ -0,0 +1,101 @@
+package Koha::Preservation::Train::Item;
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+
+use JSON qw( to_json );
+use Try::Tiny;
+
+use Koha::Database;
+
+use base qw(Koha::Object);
+
+use Koha::Items;
+use Koha::Preservation::Processings;
+use Koha::Preservation::Train::Item::Attributes;
+
+=head1 NAME
+
+Koha::Preservation::Train::Item - Koha Train::Item Object class
+
+=head1 API
+
+=head2 Class methods
+
+=cut
+
+=head3 processing
+
+Return the processing object for this item
+
+=cut
+
+sub processing {
+    my ( $self ) = @_;
+    my $rs = $self->_result->processing; # FIXME Should we return train's default processing if there is no specific?
+    return Koha::Preservation::Processing->_new_from_dbic($rs);
+}
+
+=head3 catalogue_item
+
+Return the catalogue item object for this train item
+
+=cut
+
+sub catalogue_item {
+    my ( $self ) = @_;
+    my $item_rs = $self->_result->item;
+    return Koha::Item->_new_from_dbic($item_rs);
+}
+
+=head3 attributes
+
+Getter and setter for the attributes
+
+=cut
+
+sub attributes {
+    my ( $self, $attributes ) = @_;
+
+    if ( $attributes ) {
+        my $schema = $self->_result->result_source->schema;
+        $schema->txn_do(
+            sub {
+                $self->attributes->delete;
+
+                for my $attribute (@$attributes) {
+                    $self->_result->add_to_preservation_processing_attributes_items($attribute);
+                }
+            }
+        );
+
+    }
+    my $attributes_rs = $self->_result->preservation_processing_attributes_items;
+    return Koha::Preservation::Train::Item::Attributes->_new_from_dbic($attributes_rs);
+}
+
+=head2 Internal methods
+
+=head3 _type
+
+=cut
+
+sub _type {
+    return 'PreservationTrainsItem';
+}
+
+1;

Koha/Preservation/Train/Item/Attribute.pm

@@ -0,0 +1,63 @@
+package Koha::Preservation::Train::Item::Attribute;
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+
+use JSON qw( to_json );
+use Try::Tiny;
+
+use Koha::Database;
+
+use base qw(Koha::Object);
+
+use Koha::Preservation::Processing::Attributes;
+
+=head1 NAME
+
+Koha::Preservation::Train::Item::Attribute - Koha Train::Item::Attribute Object class
+
+=head1 API
+
+=head2 Class methods
+
+=cut
+
+=head3 processing_attribute
+
+my $processing_attribute = $attribute->processing_attribute;
+
+Return the Koha::Preservation::Processing::Attribute object
+
+=cut
+
+sub processing_attribute {
+    my ( $self ) = @_;
+    my $processing_attribute_rs = $self->_result->processing_attribute;
+    return Koha::Preservation::Processing::Attribute->_new_from_dbic($processing_attribute_rs)
+}
+
+=head2 Internal methods
+
+=head3 _type
+
+=cut
+
+sub _type {
+    return 'PreservationProcessingAttributesItem';
+}
+
+1;

Koha/Preservation/Train/Item/Attributes.pm

@@ -0,0 +1,52 @@
+package Koha::Preservation::Train::Item::Attributes;
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+
+use Koha::Database;
+
+use Koha::Preservation::Train::Item::Attribute;
+
+use base qw(Koha::Objects);
+
+=head1 NAME
+
+Koha::Preservation::Train::Item::Attributes - Koha Train::Item::Attribute Object set class
+
+=head1 API
+
+=head2 Class Methods
+
+=cut
+
+=head3 type
+
+=cut
+
+sub _type {
+    return 'PreservationProcessingAttributesItem';
+}
+
+=head3 object_class
+
+=cut
+
+sub object_class {
+    return 'Koha::Preservation::Train::Item::Attribute';
+}
+
+1;

Koha/Preservation/Train/Items.pm

@@ -0,0 +1,52 @@
+package Koha::Preservation::Train::Items;
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+
+use Koha::Database;
+
+use Koha::Preservation::Train::Item;
+
+use base qw(Koha::Objects);
+
+=head1 NAME
+
+Koha::Preservation::Train::Items - Koha Train::Item Object set class
+
+=head1 API
+
+=head2 Class Methods
+
+=cut
+
+=head3 type
+
+=cut
+
+sub _type {
+    return 'PreservationTrainsItem';
+}
+
+=head3 object_class
+
+=cut
+
+sub object_class {
+    return 'Koha::Preservation::Train::Item';
+}
+
+1;

Koha/Preservation/Trains.pm

@@ -0,0 +1,52 @@
+package Koha::Preservation::Trains;
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+use Modern::Perl;
+
+use Koha::Database;
+
+use Koha::Preservation::Train;
+
+use base qw(Koha::Objects);
+
+=head1 NAME
+
+Koha::Preservation::Trains - Koha Train Object set class
+
+=head1 API
+
+=head2 Class Methods
+
+=cut
+
+=head3 type
+
+=cut
+
+sub _type {
+    return 'PreservationTrain';
+}
+
+=head3 object_class
+
+=cut
+
+sub object_class {
+    return 'Koha::Preservation::Train';
+}
+
+1;