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