Attachment #156637 for bug #30708

View | Details | Raw Unified | Return to bug 30708
Collapse All | Expand All




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;




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;




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;




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;




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;




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;




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;




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;




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;




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;




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;

Return to bug 30708

Line 0 Link Here

(-)a/Koha/Exceptions/Preservation.pm (+83 lines)
		1	package Koha::Exceptions::Preservation;
		2
		3	# This file is part of Koha.
		4	#
		5	# Koha is free software; you can redistribute it and/or modify it
		6	# under the terms of the GNU General Public License as published by
		7	# the Free Software Foundation; either version 3 of the License, or
		8	# (at your option) any later version.
		9	#
		10	# Koha is distributed in the hope that it will be useful, but
		11	# WITHOUT ANY WARRANTY; without even the implied warranty of
		12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		13	# GNU General Public License for more details.
		14	#
		15	# You should have received a copy of the GNU General Public License
		16	# along with Koha; if not, see <http://www.gnu.org/licenses>.
		17
		18	use Modern::Perl;
		19
		20	use Koha::Exception;
		21
		22	use Exception::Class (
		23
		24	'Koha::Exceptions::Preservation' => {
		25	isa => 'Koha::Exception',
		26	},
		27	'Koha::Exceptions::Preservation::MissingSettings' => {
		28	isa => 'Koha::Exceptions::Preservation',
		29	description => "Missing configuration settings",
		30	fields => ['parameter'],
		31	},
		32	'Koha::Exceptions::Preservation::ItemAlreadyInTrain' => {
		33	isa => 'Koha::Exceptions::Preservation',
		34	description => "Cannot add item to waiting list, it is already in a non-received train",
		35	},
		36	'Koha::Exceptions::Preservation::ItemNotInWaitingList' => {
		37	isa => 'Koha::Exceptions::Preservation',
		38	description => "Cannot add item to train, it is not in the waiting list",
		39	},
		40	'Koha::Exceptions::Preservation::ItemNotFound' => {
		41	isa => 'Koha::Exceptions::Preservation',
		42	description => "Cannot add item to train, the item does not exist",
		43	},
		44	);
		45
		46	sub full_message {
		47	my $self = shift;
		48
		49	my $msg = $self->message;
		50
		51	unless ( $msg ) {
		52	if ( $self->isa('Koha::Exceptions::Preservation::MissingSettings') ) {
		53	$msg = sprintf("The following parameter settings is required: %s", $self->parameter );
		54	}
		55	}
		56
		57	return $msg;
		58	}
		59
		60	=head1 NAME
		61
		62	Koha::Exceptions::Preservation - Exception class for the preservation module
		63
		64	=head1 Exceptions
65
66	=head2 Koha::Exceptions::Preservation
67
68	Generic Preservation exception
69
70	=head2 Koha::Exceptions::Preservation::MissingSettings
71
72	Exception to be used when the preservation module is not configured correctly
73	and a setting is missing
74
75	=head1 Class methods
76
77	=head2 full_message
78
79	Overloaded method for exception stringifying.
80
81	=cut
82
83	1;

Line 0 Link Here

(-)a/Koha/Preservation/Processing.pm (+72 lines)
		1	package Koha::Preservation::Processing;
		2
		3	# This file is part of Koha.
		4	#
		5	# Koha is free software; you can redistribute it and/or modify it
		6	# under the terms of the GNU General Public License as published by
		7	# the Free Software Foundation; either version 3 of the License, or
		8	# (at your option) any later version.
		9	#
		10	# Koha is distributed in the hope that it will be useful, but
		11	# WITHOUT ANY WARRANTY; without even the implied warranty of
		12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		13	# GNU General Public License for more details.
		14	#
		15	# You should have received a copy of the GNU General Public License
		16	# along with Koha; if not, see <http://www.gnu.org/licenses>.
		17
		18	use Modern::Perl;
		19
		20	use Koha::Database;
		21
		22	use base qw(Koha::Object);
		23
		24	use Koha::Preservation::Processing::Attributes;
		25
		26	=head1 NAME
		27
		28	Koha::Preservation::Processing - Koha Processing Object class
		29
		30	=head1 API
		31
		32	=head2 Class methods
		33
		34	=cut
		35
		36	=head3 attributes
		37
		38	Set or return the attributes for this processing
		39
		40	=cut
		41
		42	sub attributes {
		43	my ( $self, $attributes ) = @_;
		44
		45	if ( $attributes ) {
		46	my $schema = $self->_result->result_source->schema;
		47	$schema->txn_do(
		48	sub {
		49	$self->attributes->delete;
		50
		51	for my $attribute (@$attributes) {
		52	$self->_result->add_to_preservation_processing_attributes($attribute);
		53	}
		54	}
		55	);
		56	}
		57
		58	my $attributes_rs = $self->_result->preservation_processing_attributes;
		59	return Koha::Preservation::Processing::Attributes->_new_from_dbic($attributes_rs);
		60	}
		61
		62	=head2 Internal methods
		63
		64	=head3 _type
65
66	=cut
67
68	sub _type {
69	return 'PreservationProcessing';
70	}
71
72	1;

Line 0 Link Here

(-)a/Koha/Preservation/Processing/Attribute.pm (+44 lines)
	1	package Koha::Preservation::Processing::Attribute;
	2
	3	# This file is part of Koha.
	4	#
	5	# Koha is free software; you can redistribute it and/or modify it
	6	# under the terms of the GNU General Public License as published by
	7	# the Free Software Foundation; either version 3 of the License, or
	8	# (at your option) any later version.
	9	#
	10	# Koha is distributed in the hope that it will be useful, but
	11	# WITHOUT ANY WARRANTY; without even the implied warranty of
	12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	13	# GNU General Public License for more details.
	14	#
	15	# You should have received a copy of the GNU General Public License
	16	# along with Koha; if not, see <http://www.gnu.org/licenses>.
	17
	18	use Modern::Perl;
	19
	20	use Koha::Database;
	21
	22	use base qw(Koha::Object);
	23
	24	=head1 NAME
	25
	26	Koha::Preservation::Processing::Attribute - Koha Processing Attribute Object class
	27
	28	=head1 API
	29
	30	=head2 Class Methods
	31
	32	=cut
	33
	34	=head2 Internal methods
	35
	36	=head3 _type
	37
	38	=cut
	39
	40	sub _type {
	41	return 'PreservationProcessingAttribute';
	42	}
	43
	44	1;

Line 0 Link Here

(-)a/Koha/Preservation/Processing/Attributes.pm (+53 lines)
	1	package Koha::Preservation::Processing::Attributes;
	2
	3	# This file is part of Koha.
	4	#
	5	# Koha is free software; you can redistribute it and/or modify it
	6	# under the terms of the GNU General Public License as published by
	7	# the Free Software Foundation; either version 3 of the License, or
	8	# (at your option) any later version.
	9	#
	10	# Koha is distributed in the hope that it will be useful, but
	11	# WITHOUT ANY WARRANTY; without even the implied warranty of
	12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	13	# GNU General Public License for more details.
	14	#
	15	# You should have received a copy of the GNU General Public License
	16	# along with Koha; if not, see <http://www.gnu.org/licenses>.
	17
	18	use Modern::Perl;
	19
	20
	21	use Koha::Database;
	22
	23	use Koha::Preservation::Processing::Attribute;
	24
	25	use base qw(Koha::Objects);
	26
	27	=head1 NAME
	28
	29	Koha::Preservation::Processing::Attributes - Koha Processing Attribute Object set class
	30
	31	=head1 API
	32
	33	=head2 Class Methods
	34
	35	=cut
	36
	37	=head3 type
	38
	39	=cut
	40
	41	sub _type {
	42	return 'PreservationProcessingAttribute';
	43	}
	44
	45	=head3 object_class
	46
	47	=cut
	48
	49	sub object_class {
	50	return 'Koha::Preservation::Processing::Attribute';
	51	}
	52
	53	1;

Line 0 Link Here

(-)a/Koha/Preservation/Processings.pm (+52 lines)
	1	package Koha::Preservation::Processings;
	2
	3	# This file is part of Koha.
	4	#
	5	# Koha is free software; you can redistribute it and/or modify it
	6	# under the terms of the GNU General Public License as published by
	7	# the Free Software Foundation; either version 3 of the License, or
	8	# (at your option) any later version.
	9	#
	10	# Koha is distributed in the hope that it will be useful, but
	11	# WITHOUT ANY WARRANTY; without even the implied warranty of
	12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	13	# GNU General Public License for more details.
	14	#
	15	# You should have received a copy of the GNU General Public License
	16	# along with Koha; if not, see <http://www.gnu.org/licenses>.
	17
	18	use Modern::Perl;
	19
	20	use Koha::Database;
	21
	22	use Koha::Preservation::Processing;
	23
	24	use base qw(Koha::Objects);
	25
	26	=head1 NAME
	27
	28	Koha::Preservation::Processings - Koha Processing Object set class
	29
	30	=head1 API
	31
	32	=head2 Class Methods
	33
	34	=cut
	35
	36	=head3 type
	37
	38	=cut
	39
	40	sub _type {
	41	return 'PreservationProcessing';
	42	}
	43
	44	=head3 object_class
	45
	46	=cut
	47
	48	sub object_class {
	49	return 'Koha::Preservation::Processing';
	50	}
	51
	52	1;

Line 0 Link Here

(-)a/Koha/Preservation/Train.pm (+133 lines)
		1	package Koha::Preservation::Train;
		2
		3	# This file is part of Koha.
		4	#
		5	# Koha is free software; you can redistribute it and/or modify it
		6	# under the terms of the GNU General Public License as published by
		7	# the Free Software Foundation; either version 3 of the License, or
		8	# (at your option) any later version.
		9	#
		10	# Koha is distributed in the hope that it will be useful, but
		11	# WITHOUT ANY WARRANTY; without even the implied warranty of
		12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		13	# GNU General Public License for more details.
		14	#
		15	# You should have received a copy of the GNU General Public License
		16	# along with Koha; if not, see <http://www.gnu.org/licenses>.
		17
		18	use Modern::Perl;
		19
		20	use JSON qw( to_json );
		21	use Try::Tiny;
		22
		23	use Koha::Database;
		24
		25	use base qw(Koha::Object);
		26
		27	use Koha::Preservation::Processings;
		28	use Koha::Preservation::Train::Items;
		29
		30	use Koha::Exceptions::Preservation;
		31
		32	=head1 NAME
		33
		34	Koha::Preservation::Train - Koha Train Object class
		35
		36	=head1 API
		37
		38	=head2 Class methods
		39
		40	=cut
		41
		42	=head3 default_processing
		43
		44	Return the default processing object for this train
		45
		46	=cut
		47
		48	sub default_processing {
		49	my ( $self ) = @_;
		50	my $rs = $self->_result->default_processing;
		51	return unless $rs;
		52	return Koha::Preservation::Processing->_new_from_dbic($rs);
		53	}
		54
		55	=head3 add_item
		56
		57	Add item to this train
		58
		59	my $train_item = $train->add_item({item_id => $itemnumber, processing_id => $processing_id});
		60	my $train_item = $train->add_item({barcode => $barcode, processing_id => $processing_id});
		61
		62	=cut
		63
		64	sub add_item {
65	my ( $self, $train_item ) = @_;
66
67	my $not_for_loan = C4::Context->preference('PreservationNotForLoanWaitingListIn');
68
69	my $key = exists $train_item->{item_id} ? 'itemnumber' : 'barcode';
70	my $item = Koha::Items->find( { $key => $train_item->{item_id} \|\| $train_item->{barcode} } );
71	Koha::Exceptions::Preservation::ItemNotFound->throw unless $item;
72	Koha::Exceptions::Preservation::ItemNotInWaitingList->throw if $item->notforloan != $not_for_loan;
73
74	my $train_item_rs = $self->_result->add_to_preservation_trains_items(
75	{
76	item_id => $item->itemnumber,
77	processing_id => $train_item->{processing_id} \|\| $self->default_processing_id,
78	added_on => \'NOW()',
79	}
80	);
81	$item->notforloan( $self->not_for_loan )->store;
82	return Koha::Preservation::Train::Item->_new_from_dbic($train_item_rs);
83	}
84
85	=head3 add_items
86
87	my $train_items = $train->add_items([$item_1, $item_2]);
88
89	Add items in batch.
90
91	=cut
92
93	sub add_items {
94	my ( $self, $train_items ) = @_;
95	my @added_items;
96	for my $train_item (@$train_items) {
97	try {
98	push @added_items, $self->add_item($train_item);
99	} catch {
100
101	# FIXME Do we rollback and raise an error or just skip it?
102	# FIXME See status code 207 partial success
103	warn "Item not added to train: " . $_;
104	};
105	}
106	return Koha::Preservation::Train::Items->search( { train_item_id => [ map { $_->train_item_id } @added_items ] } );
107	}
108
109	=head3 items
110
111	my $items = $train->items;
112
113	Return the items in this train.
114
115	=cut
116
117	sub items {
118	my ( $self ) = @_;
119	my $items_rs = $self->_result->preservation_trains_items;
120	return Koha::Preservation::Train::Items->_new_from_dbic($items_rs)
121	}
122
123	=head2 Internal methods
124
125	=head3 _type
126
127	=cut
128
129	sub _type {
130	return 'PreservationTrain';
131	}
132
133	1;

Line 0 Link Here

(-)a/Koha/Preservation/Train/Item.pm (+101 lines)
		1	package Koha::Preservation::Train::Item;
		2
		3	# This file is part of Koha.
		4	#
		5	# Koha is free software; you can redistribute it and/or modify it
		6	# under the terms of the GNU General Public License as published by
		7	# the Free Software Foundation; either version 3 of the License, or
		8	# (at your option) any later version.
		9	#
		10	# Koha is distributed in the hope that it will be useful, but
		11	# WITHOUT ANY WARRANTY; without even the implied warranty of
		12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		13	# GNU General Public License for more details.
		14	#
		15	# You should have received a copy of the GNU General Public License
		16	# along with Koha; if not, see <http://www.gnu.org/licenses>.
		17
		18	use Modern::Perl;
		19
		20	use JSON qw( to_json );
		21	use Try::Tiny;
		22
		23	use Koha::Database;
		24
		25	use base qw(Koha::Object);
		26
		27	use Koha::Items;
		28	use Koha::Preservation::Processings;
		29	use Koha::Preservation::Train::Item::Attributes;
		30
		31	=head1 NAME
		32
		33	Koha::Preservation::Train::Item - Koha Train::Item Object class
		34
		35	=head1 API
		36
		37	=head2 Class methods
		38
		39	=cut
		40
		41	=head3 processing
		42
		43	Return the processing object for this item
		44
		45	=cut
		46
		47	sub processing {
		48	my ( $self ) = @_;
		49	my $rs = $self->_result->processing; # FIXME Should we return train's default processing if there is no specific?
		50	return Koha::Preservation::Processing->_new_from_dbic($rs);
		51	}
		52
		53	=head3 catalogue_item
		54
		55	Return the catalogue item object for this train item
		56
		57	=cut
		58
		59	sub catalogue_item {
		60	my ( $self ) = @_;
		61	my $item_rs = $self->_result->item;
		62	return Koha::Item->_new_from_dbic($item_rs);
		63	}
		64
65	=head3 attributes
66
67	Getter and setter for the attributes
68
69	=cut
70
71	sub attributes {
72	my ( $self, $attributes ) = @_;
73
74	if ( $attributes ) {
75	my $schema = $self->_result->result_source->schema;
76	$schema->txn_do(
77	sub {
78	$self->attributes->delete;
79
80	for my $attribute (@$attributes) {
81	$self->_result->add_to_preservation_processing_attributes_items($attribute);
82	}
83	}
84	);
85
86	}
87	my $attributes_rs = $self->_result->preservation_processing_attributes_items;
88	return Koha::Preservation::Train::Item::Attributes->_new_from_dbic($attributes_rs);
89	}
90
91	=head2 Internal methods
92
93	=head3 _type
94
95	=cut
96
97	sub _type {
98	return 'PreservationTrainsItem';
99	}
100
101	1;

Line 0 Link Here

(-)a/Koha/Preservation/Train/Item/Attribute.pm (+63 lines)
	1	package Koha::Preservation::Train::Item::Attribute;
	2
	3	# This file is part of Koha.
	4	#
	5	# Koha is free software; you can redistribute it and/or modify it
	6	# under the terms of the GNU General Public License as published by
	7	# the Free Software Foundation; either version 3 of the License, or
	8	# (at your option) any later version.
	9	#
	10	# Koha is distributed in the hope that it will be useful, but
	11	# WITHOUT ANY WARRANTY; without even the implied warranty of
	12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	13	# GNU General Public License for more details.
	14	#
	15	# You should have received a copy of the GNU General Public License
	16	# along with Koha; if not, see <http://www.gnu.org/licenses>.
	17
	18	use Modern::Perl;
	19
	20	use JSON qw( to_json );
	21	use Try::Tiny;
	22
	23	use Koha::Database;
	24
	25	use base qw(Koha::Object);
	26
	27	use Koha::Preservation::Processing::Attributes;
	28
	29	=head1 NAME
	30
	31	Koha::Preservation::Train::Item::Attribute - Koha Train::Item::Attribute Object class
	32
	33	=head1 API
	34
	35	=head2 Class methods
	36
	37	=cut
	38
	39	=head3 processing_attribute
	40
	41	my $processing_attribute = $attribute->processing_attribute;
	42
	43	Return the Koha::Preservation::Processing::Attribute object
	44
	45	=cut
	46
	47	sub processing_attribute {
	48	my ( $self ) = @_;
	49	my $processing_attribute_rs = $self->_result->processing_attribute;
	50	return Koha::Preservation::Processing::Attribute->_new_from_dbic($processing_attribute_rs)
	51	}
	52
	53	=head2 Internal methods
	54
	55	=head3 _type
	56
	57	=cut
	58
	59	sub _type {
	60	return 'PreservationProcessingAttributesItem';
	61	}
	62
	63	1;

Line 0 Link Here

(-)a/Koha/Preservation/Train/Items.pm (+52 lines)
	1	package Koha::Preservation::Train::Items;
	2
	3	# This file is part of Koha.
	4	#
	5	# Koha is free software; you can redistribute it and/or modify it
	6	# under the terms of the GNU General Public License as published by
	7	# the Free Software Foundation; either version 3 of the License, or
	8	# (at your option) any later version.
	9	#
	10	# Koha is distributed in the hope that it will be useful, but
	11	# WITHOUT ANY WARRANTY; without even the implied warranty of
	12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	13	# GNU General Public License for more details.
	14	#
	15	# You should have received a copy of the GNU General Public License
	16	# along with Koha; if not, see <http://www.gnu.org/licenses>.
	17
	18	use Modern::Perl;
	19
	20	use Koha::Database;
	21
	22	use Koha::Preservation::Train::Item;
	23
	24	use base qw(Koha::Objects);
	25
	26	=head1 NAME
	27
	28	Koha::Preservation::Train::Items - Koha Train::Item Object set class
	29
	30	=head1 API
	31
	32	=head2 Class Methods
	33
	34	=cut
	35
	36	=head3 type
	37
	38	=cut
	39
	40	sub _type {
	41	return 'PreservationTrainsItem';
	42	}
	43
	44	=head3 object_class
	45
	46	=cut
	47
	48	sub object_class {
	49	return 'Koha::Preservation::Train::Item';
	50	}
	51
	52	1;

Line 0 Link Here

(-)a/Koha/Preservation/Trains.pm (-1 / +52 lines)
0	-	1	package Koha::Preservation::Trains;
		2
		3	# This file is part of Koha.
		4	#
		5	# Koha is free software; you can redistribute it and/or modify it
		6	# under the terms of the GNU General Public License as published by
		7	# the Free Software Foundation; either version 3 of the License, or
		8	# (at your option) any later version.
		9	#
		10	# Koha is distributed in the hope that it will be useful, but
		11	# WITHOUT ANY WARRANTY; without even the implied warranty of
		12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		13	# GNU General Public License for more details.
		14	#
		15	# You should have received a copy of the GNU General Public License
		16	# along with Koha; if not, see <http://www.gnu.org/licenses>.
		17
		18	use Modern::Perl;
		19
		20	use Koha::Database;
		21
		22	use Koha::Preservation::Train;
		23
		24	use base qw(Koha::Objects);
		25
		26	=head1 NAME
		27
		28	Koha::Preservation::Trains - Koha Train Object set class
		29
		30	=head1 API
		31
		32	=head2 Class Methods
		33
		34	=cut
		35
		36	=head3 type
		37
		38	=cut
		39
		40	sub _type {
		41	return 'PreservationTrain';
		42	}
		43
		44	=head3 object_class
		45
		46	=cut
		47
		48	sub object_class {
		49	return 'Koha::Preservation::Train';
		50	}
		51
		52	1;