Koha/ERM/Agreement.pm

   1 package Koha::ERM::Agreement;
   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 MIME::Base64 qw( decode_base64 );
  21 use MIME::Types;
  22
  23 use Koha::Database;
  24 use Koha::DateUtils qw( dt_from_string );
  25 use Koha::Exceptions;
  26 use Koha::Acquisition::Bookseller;
  27
  28 use base qw(Koha::Object);
  29
  30 use Koha::ERM::Agreement::Periods;
  31 use Koha::ERM::Agreement::Licenses;
  32 use Koha::ERM::Agreement::Relationships;
  33 use Koha::ERM::UserRoles;
  34 use Koha::ERM::Documents;
  35 use Koha::ERM::EHoldings::Package::Agreements;
  36
  37 =head1 NAME
  38
  39 Koha::ERM::Agreement - Koha ErmAgreement Object class
  40
  41 =head1 API
  42
  43 =head2 Class Methods
  44
  45 =cut
  46
  47 =head3 periods
  48
  49 Returns the periods for this agreement
  50
  51 =cut
  52
  53 sub periods {
  54     my ( $self, $periods ) = @_;
  55
  56     if ( $periods ) {
  57         my $schema = $self->_result->result_source->schema;
  58         $schema->txn_do(
  59             sub {
  60                 $self->periods->delete;
  61
  62                 for my $period (@$periods) {
  63                     $self->_result->add_to_erm_agreement_periods($period);
  64                 }
  65             }
  66         );
  67     }
  68
  69     my $periods_rs = $self->_result->erm_agreement_periods;
  70     return Koha::ERM::Agreement::Periods->_new_from_dbic($periods_rs);
  71 }
  72
  73 =head3 user_roles
  74
  75 Returns the user roles for this agreement
  76
  77 =cut
  78
  79 sub user_roles {
  80     my ( $self, $user_roles ) = @_;
  81
  82     if ( $user_roles ) {
  83         my $schema = $self->_result->result_source->schema;
  84         $schema->txn_do(
  85             sub {
  86                 $self->user_roles->delete;
  87
  88                 for my $user_role (@$user_roles) {
  89                     $self->_result->add_to_erm_user_roles($user_role);
  90                 }
  91             }
  92         );
  93     }
  94     my $user_roles_rs = $self->_result->erm_user_roles;
  95     return Koha::ERM::UserRoles->_new_from_dbic($user_roles_rs);
  96 }
  97
  98 =head3 agreement_licenses
  99
 100 Returns the agreement_licenses for this agreement
 101
 102 =cut
 103
 104 sub agreement_licenses {
 105     my ( $self, $agreement_licenses ) = @_;
 106
 107     if ( $agreement_licenses ) {
 108         my $controlling = grep { $_->{status} eq 'controlling' } @$agreement_licenses;
 109         if ( $controlling > 1 ) {
 110             Koha::Exceptions::DuplicateObject->throw(
 111                 "Only one controlling license can exist for a given agreement");
 112         }
 113
 114         my $schema = $self->_result->result_source->schema;
 115         $schema->txn_do(
 116             sub {
 117                 $self->agreement_licenses->delete;
 118
 119                 for my $agreement_license (@$agreement_licenses) {
 120                     $self->_result->add_to_erm_agreement_licenses($agreement_license);
 121                 }
 122             }
 123         );
 124     }
 125     my $agreement_licenses_rs = $self->_result->erm_agreement_licenses;
 126     return Koha::ERM::Agreement::Licenses->_new_from_dbic($agreement_licenses_rs);
 127 }
 128
 129 =head3 agreement_relationships
 130
 131 Returns the agreement relationships of this agreement
 132
 133 =cut
 134
 135 sub agreement_relationships {
 136     my ( $self, $relationships ) = @_;
 137
 138     if ( $relationships ) {
 139         my $schema = $self->_result->result_source->schema;
 140         # FIXME naming - is "back link" ok?
 141         my $back_links = {
 142             'supersedes'       => 'is-superseded-by',
 143             'is-superseded-by' => 'supersedes',
 144             'provides_post-cancellation_access_for' => 'has-post-cancellation-access-in',
 145             'has-post-cancellation-access-in'       => 'provides_post-cancellation_access_for',
 146             'tracks_demand-driven_acquisitions_for' => 'has-demand-driven-acquisitions-in',
 147             'has-demand-driven-acquisitions-in'     => 'tracks_demand-driven_acquisitions_for',
 148             'has_backfile_in'  => 'has_frontfile_in',
 149             'has_frontfile_in' => 'has_backfile_in',
 150             'related_to'       => 'related_to',
 151         };
 152         $schema->txn_do(
 153             sub {
 154                 $self->agreement_relationships->delete;
 155                 $self->agreement_back_relationships->delete;
 156
 157                 for my $relationship (@$relationships) {
 158                     $self->_result->add_to_erm_agreement_relationships_agreements($relationship);
 159                     my $back_link = {
 160                         agreement_id => $relationship->{related_agreement_id},
 161                         related_agreement_id => $self->agreement_id,
 162                         relationship => $back_links->{$relationship->{relationship}},
 163                         notes        => $relationship->{notes}, # FIXME Is it correct, do we keep the note here?
 164                     };
 165                     $self->_result->add_to_erm_agreement_relationships_related_agreements($back_link);
 166                 }
 167             }
 168         );
 169     }
 170     my $related_agreements_rs = $self->_result->erm_agreement_relationships_agreements;
 171     return Koha::ERM::Agreement::Relationships->_new_from_dbic($related_agreements_rs);
 172 }
 173
 174 =head3 agreement_back_relationships
 175
 176 # FIXME Naming - how is it called?
 177 Returns the reverse relationship
 178
 179 =cut
 180
 181 sub agreement_back_relationships {
 182     my ( $self ) = @_;
 183     my $rs = $self->_result->erm_agreement_relationships_related_agreements;
 184     return Koha::ERM::Agreement::Relationships->_new_from_dbic($rs);
 185 }
 186
 187 =head3 documents
 188
 189 Returns the documents for this agreement
 190
 191 =cut
 192
 193 =head3 documents
 194
 195 Returns or updates the documents for this agreement
 196
 197 =cut
 198
 199 sub documents {
 200     my ( $self, $documents ) = @_;
 201     if ($documents) {
 202         $self->documents->replace_with($documents, $self);
 203     }
 204     my $documents_rs = $self->_result->erm_documents;
 205     return Koha::ERM::Documents->_new_from_dbic($documents_rs);
 206 }
 207
 208 =head3 agreement_packages
 209
 210 Return the local packages for this agreement (and the other ones that have an entry locally)
 211
 212 =cut
 213
 214 sub agreement_packages {
 215     my ( $self ) = @_;
 216     my $packages_agreements_rs = $self->_result->erm_eholdings_packages_agreements;
 217     return Koha::ERM::EHoldings::Package::Agreements->_new_from_dbic($packages_agreements_rs);
 218 }
 219
 220 =head3 vendor
 221
 222 Return the vendor for this agreement
 223
 224 =cut
 225
 226 sub vendor {
 227     my ( $self ) = @_;
 228     my $vendor_rs = $self->_result->vendor;
 229     return unless $vendor_rs;
 230     return Koha::Acquisition::Bookseller->_new_from_dbic($vendor_rs);
 231 }
 232
 233 =head2 Internal methods
 234
 235 =head3 _type
 236
 237 =cut
 238
 239 sub _type {
 240     return 'ErmAgreement';
 241 }
 242
 243 1;