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
  27 use base qw(Koha::Object);
  28
  29 use Koha::ERM::Agreement::Periods;
  30 use Koha::ERM::Agreement::UserRoles;
  31 use Koha::ERM::Agreement::Licenses;
  32 use Koha::ERM::Agreement::Relationships;
  33 use Koha::ERM::Agreement::Documents;
  34 use Koha::ERM::EHoldings::Package::Agreements;
  35
  36 =head1 NAME
  37
  38 Koha::ERM::Agreement - Koha ErmAgreement Object class
  39
  40 =head1 API
  41
  42 =head2 Class Methods
  43
  44 =cut
  45
  46 =head3 periods
  47
  48 Returns the periods for this agreement
  49
  50 =cut
  51
  52 sub periods {
  53     my ( $self, $periods ) = @_;
  54
  55     if ( $periods ) {
  56         my $schema = $self->_result->result_source->schema;
  57         $schema->txn_do(
  58             sub {
  59                 $self->periods->delete;
  60
  61                 for my $period (@$periods) {
  62                     $self->_result->add_to_erm_agreement_periods($period);
  63                 }
  64             }
  65         );
  66     }
  67
  68     my $periods_rs = $self->_result->erm_agreement_periods;
  69     return Koha::ERM::Agreement::Periods->_new_from_dbic($periods_rs);
  70 }
  71
  72 =head3 user_roles
  73
  74 Returns the user roles for this agreement
  75
  76 =cut
  77
  78 sub user_roles {
  79     my ( $self, $user_roles ) = @_;
  80
  81     if ( $user_roles ) {
  82         my $schema = $self->_result->result_source->schema;
  83         $schema->txn_do(
  84             sub {
  85                 $self->user_roles->delete;
  86
  87                 for my $user_role (@$user_roles) {
  88                     $self->_result->add_to_erm_agreement_user_roles($user_role);
  89                 }
  90             }
  91         );
  92     }
  93     my $user_roles_rs = $self->_result->erm_agreement_user_roles;
  94     return Koha::ERM::Agreement::UserRoles->_new_from_dbic($user_roles_rs);
  95 }
  96
  97 =head3 agreement_licenses
  98
  99 Returns the agreement_licenses for this agreement
 100
 101 =cut
 102
 103 sub agreement_licenses {
 104     my ( $self, $agreement_licenses ) = @_;
 105
 106     if ( $agreement_licenses ) {
 107         my $controlling = grep { $_->{status} eq 'controlling' } @$agreement_licenses;
 108         if ( $controlling > 1 ) {
 109             Koha::Exceptions::DuplicateObject->throw(
 110                 "Only one controlling license can exist for a given agreement");
 111         }
 112
 113         my $schema = $self->_result->result_source->schema;
 114         $schema->txn_do(
 115             sub {
 116                 $self->agreement_licenses->delete;
 117
 118                 for my $agreement_license (@$agreement_licenses) {
 119                     $self->_result->add_to_erm_agreement_licenses($agreement_license);
 120                 }
 121             }
 122         );
 123     }
 124     my $agreement_licenses_rs = $self->_result->erm_agreement_licenses;
 125     return Koha::ERM::Agreement::Licenses->_new_from_dbic($agreement_licenses_rs);
 126 }
 127
 128 =head3 agreement_relationships
 129
 130 Returns the agreement relationships of this agreement
 131
 132 =cut
 133
 134 sub agreement_relationships {
 135     my ( $self, $relationships ) = @_;
 136
 137     if ( $relationships ) {
 138         my $schema = $self->_result->result_source->schema;
 139         # FIXME naming - is "back link" ok?
 140         my $back_links = {
 141             'supersedes'       => 'is-superseded-by',
 142             'is-superseded-by' => 'supersedes',
 143             'provides_post-cancellation_access_for' => 'has-post-cancellation-access-in',
 144             'has-post-cancellation-access-in'       => 'provides_post-cancellation_access_for',
 145             'tracks_demand-driven_acquisitions_for' => 'has-demand-driven-acquisitions-in',
 146             'has-demand-driven-acquisitions-in'     => 'tracks_demand-driven_acquisitions_for',
 147             'has_backfile_in'  => 'has_frontfile_in',
 148             'has_frontfile_in' => 'has_backfile_in',
 149             'related_to'       => 'related_to',
 150         };
 151         $schema->txn_do(
 152             sub {
 153                 $self->agreement_relationships->delete;
 154                 $self->agreement_back_relationships->delete;
 155
 156                 for my $relationship (@$relationships) {
 157                     $self->_result->add_to_erm_agreement_relationships_agreements($relationship);
 158                     my $back_link = {
 159                         agreement_id => $relationship->{related_agreement_id},
 160                         related_agreement_id => $self->agreement_id,
 161                         relationship => $back_links->{$relationship->{relationship}},
 162                         notes        => $relationship->{notes}, # FIXME Is it correct, do we keep the note here?
 163                     };
 164                     $self->_result->add_to_erm_agreement_relationships_related_agreements($back_link);
 165                 }
 166             }
 167         );
 168     }
 169     my $related_agreements_rs = $self->_result->erm_agreement_relationships_agreements;
 170     return Koha::ERM::Agreement::Relationships->_new_from_dbic($related_agreements_rs);
 171 }
 172
 173 =head3 agreement_back_relationships
 174
 175 # FIXME Naming - how is it called?
 176 Returns the reverse relationship
 177
 178 =cut
 179
 180 sub agreement_back_relationships {
 181     my ( $self ) = @_;
 182     my $rs = $self->_result->erm_agreement_relationships_related_agreements;
 183     return Koha::ERM::Agreement::Relationships->_new_from_dbic($rs);
 184 }
 185
 186 =head3 documents
 187
 188 Returns the documents for this agreement
 189
 190 =cut
 191
 192 sub documents {
 193     my ( $self, $documents ) = @_;
 194
 195     if ($documents) {
 196         my $schema = $self->_result->result_source->schema;
 197         $schema->txn_do(
 198             sub {
 199                 my $existing_documents = $self->documents;
 200
 201                 # FIXME Here we are not deleting all the documents before recreating them, like we do for other related resources.
 202                 # As we do not want the content of the documents to transit over the network we need to use the document_id (and allow it in the API spec)
 203                 # to distinguish from each other
 204                 # Delete all the documents that are not part of the PUT request
 205                 my $modified_document_ids = [ map { $_->{document_id} || () } @$documents ];
 206                 $self->documents->search(
 207                     {
 208                         @$modified_document_ids
 209                         ? (
 210                             document_id => {
 211                                 '-not_in' => $modified_document_ids
 212                             }
 213                           )
 214                         : ()
 215                     }
 216                 )->delete;
 217
 218                 for my $document (@$documents) {
 219                     if ( $document->{document_id} ) {
 220                         # The document already exists in DB
 221                         $existing_documents->find( $document->{document_id} )
 222                           ->set(
 223                             {
 224                                 file_description  => $document->{file_description},
 225                                 physical_location => $document->{physical_location},
 226                                 uri               => $document->{uri},
 227                                 notes             => $document->{notes},
 228                             }
 229                         )->store;
 230                     }
 231                     else {
 232                         # Creating a whole new document
 233                         my $file_content = decode_base64( $document->{file_content} );
 234                         my $mt = MIME::Types->new();
 235                         $document->{file_type} = $mt->mimeTypeOf( $document->{file_name} );
 236                         $document->{uploaded_on} //= dt_from_string;
 237                         $document->{file_content} = $file_content;
 238                         $self->_result->add_to_erm_agreement_documents( $document);
 239                     }
 240                 }
 241             }
 242         );
 243     }
 244     my $documents_rs = $self->_result->erm_agreement_documents;
 245     return Koha::ERM::Agreement::Documents->_new_from_dbic($documents_rs);
 246 }
 247
 248 =head3 agreement_packages
 249
 250 Return the local packages for this agreement (and the other ones that have an entry locally)
 251
 252 =cut
 253
 254 sub agreement_packages {
 255     my ( $self ) = @_;
 256     my $packages_agreements_rs = $self->_result->erm_eholdings_packages_agreements;
 257     return Koha::ERM::EHoldings::Package::Agreements->_new_from_dbic($packages_agreements_rs);
 258 }
 259
 260 =head2 Internal methods
 261
 262 =head3 _type
 263
 264 =cut
 265
 266 sub _type {
 267     return 'ErmAgreement';
 268 }
 269
 270 1;