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