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

(-)a/Koha/Exceptions/Preservation.pm (+83 lines)
Line 0 Link Here
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;
(-)a/Koha/Preservation/Processing.pm (+72 lines)
Line 0 Link Here
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;
(-)a/Koha/Preservation/Processing/Attribute.pm (+44 lines)
Line 0 Link Here
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;
(-)a/Koha/Preservation/Processing/Attributes.pm (+53 lines)
Line 0 Link Here
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;
(-)a/Koha/Preservation/Processings.pm (+52 lines)
Line 0 Link Here
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;
(-)a/Koha/Preservation/Train.pm (+133 lines)
Line 0 Link Here
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;
(-)a/Koha/Preservation/Train/Item.pm (+101 lines)
Line 0 Link Here
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;
(-)a/Koha/Preservation/Train/Item/Attribute.pm (+63 lines)
Line 0 Link Here
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;
(-)a/Koha/Preservation/Train/Item/Attributes.pm (+52 lines)
Line 0 Link Here
1
package Koha::Preservation::Train::Item::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
use Koha::Database;
21
22
use Koha::Preservation::Train::Item::Attribute;
23
24
use base qw(Koha::Objects);
25
26
=head1 NAME
27
28
Koha::Preservation::Train::Item::Attributes - Koha Train::Item::Attribute 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 'PreservationProcessingAttributesItem';
42
}
43
44
=head3 object_class
45
46
=cut
47
48
sub object_class {
49
    return 'Koha::Preservation::Train::Item::Attribute';
50
}
51
52
1;
(-)a/Koha/Preservation/Train/Items.pm (+52 lines)
Line 0 Link Here
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;
(-)a/Koha/Preservation/Trains.pm (-1 / +52 lines)
Line 0 Link Here
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;

Return to bug 30708