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