Koha/Illrequest/Config.pm

   1 package Koha::Illrequest::Config;
   2
   3 # Copyright 2013,2014 PTFS Europe Ltd
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 3 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use Modern::Perl;
  21 use C4::Context;
  22
  23 =head1 NAME
  24
  25 Koha::Illrequest::Config - Koha ILL Configuration Object
  26
  27 =head1 SYNOPSIS
  28
  29 Object-oriented class that giving access to the illconfig data derived
  30 from ill/config.yaml.
  31
  32 =head1 DESCRIPTION
  33
  34 Config object providing abstract representation of the expected XML
  35 returned by ILL API.
  36
  37 In particular the config object uses a YAML file, whose path is
  38 defined by <illconfig> in koha-conf.xml. That YAML file provides the
  39 data structure exposed in this object.
  40
  41 By default the configured data structure complies with fields used by
  42 the British Library Interlibrary Loan DSS API.
  43
  44 The config file also provides mappings for Record Object accessors.
  45
  46 =head1 API
  47
  48 =head2 Class Methods
  49
  50 =head3 new
  51
  52     my $config = Koha::Illrequest::Config->new();
  53
  54 Create a new Koha::Illrequest::Config object, with mapping data loaded from the
  55 ILL configuration file.
  56
  57 =cut
  58
  59 sub new {
  60     my ( $class ) = @_;
  61     my $self  = {};
  62
  63     $self->{configuration} = _load_configuration(
  64         C4::Context->config("interlibrary_loans"),
  65         C4::Context->preference("UnmediatedILL")
  66       );
  67
  68     bless $self, $class;
  69
  70     return $self;
  71 }
  72
  73 =head3 backend
  74
  75     $backend = $config->backend($name);
  76     $backend = $config->backend;
  77
  78 Standard setter/accessor for our backend.
  79
  80 =cut
  81
  82 sub backend {
  83     my ( $self, $new ) = @_;
  84     $self->{configuration}->{backend} = $new if $new;
  85     return $self->{configuration}->{backend};
  86 }
  87
  88 =head3 backend_dir
  89
  90     $backend_dir = $config->backend_dir($new_path);
  91     $backend_dir = $config->backend_dir;
  92
  93 Standard setter/accessor for our backend_directory.
  94
  95 =cut
  96
  97 sub backend_dir {
  98     my ( $self, $new ) = @_;
  99     $self->{configuration}->{backend_directory} = $new if $new;
 100     return $self->{configuration}->{backend_directory};
 101 }
 102
 103 =head3 partner_code
 104
 105     $partner_code = $config->partner_code($new_code);
 106     $partner_code = $config->partner_code;
 107
 108 Standard setter/accessor for our partner_code.
 109
 110 =cut
 111
 112 sub partner_code {
 113     my ( $self, $new ) = @_;
 114     $self->{configuration}->{partner_code} = $new if $new;
 115     return $self->{configuration}->{partner_code};
 116 }
 117
 118 =head3 limits
 119
 120     $limits = $config->limits($limitshash);
 121     $limits = $config->limits;
 122
 123 Standard setter/accessor for our limits.  No parsing is performed on
 124 $LIMITSHASH, so caution should be exercised when using this setter.
 125
 126 =cut
 127
 128 sub limits {
 129     my ( $self, $new ) = @_;
 130     $self->{configuration}->{limits} = $new if $new;
 131     return $self->{configuration}->{limits};
 132 }
 133
 134 =head3 getPrefixes
 135
 136     my $prefixes = $config->getPrefixes('brw_cat' | 'branch');
 137
 138 Return the prefix for ILLs defined by our config.
 139
 140 =cut
 141
 142 sub getPrefixes {
 143     my ( $self, $type ) = @_;
 144     die "Unexpected type." unless ( $type eq 'brw_cat' || $type eq 'branch' );
 145     my $values = $self->{configuration}->{prefixes}->{$type};
 146     $values->{default} = $self->{configuration}->{prefixes}->{default};
 147     return $values;
 148 }
 149
 150 =head3 getLimitRules
 151
 152     my $rules = $config->getLimitRules('brw_cat' | 'branch')
 153
 154 Return the hash of ILL limit rules defined by our config.
 155
 156 =cut
 157
 158 sub getLimitRules {
 159     my ( $self, $type ) = @_;
 160     die "Unexpected type." unless ( $type eq 'brw_cat' || $type eq 'branch' );
 161     my $values = $self->{configuration}->{limits}->{$type};
 162     $values->{default} = $self->{configuration}->{limits}->{default};
 163     return $values;
 164 }
 165
 166 =head3 getDigitalRecipients
 167
 168     my $recipient_rules= $config->getDigitalRecipients('brw_cat' | 'branch');
 169
 170 Return the hash of digital_recipient settings defined by our config.
 171
 172 =cut
 173
 174 sub getDigitalRecipients {
 175     my ( $self, $type ) = @_;
 176     die "Unexpected type." unless ( $type eq 'brw_cat' || $type eq 'branch' );
 177     my $values = $self->{configuration}->{digital_recipients}->{$type};
 178     $values->{default} =
 179         $self->{configuration}->{digital_recipients}->{default};
 180     return $values;
 181 }
 182
 183 =head3 censorship
 184
 185     my $censoredValues = $config->censorship($hash);
 186     my $censoredValues = $config->censorship;
 187
 188 Standard setter/accessor for our limits.  No parsing is performed on $HASH, so
 189 caution should be exercised when using this setter.
 190
 191 Return our censorship values for the OPAC as loaded from the koha-conf.xml, or
 192 the fallback value (no censorship).
 193
 194 =cut
 195
 196 sub censorship {
 197     my ( $self, $new ) = @_;
 198     $self->{configuration}->{censorship} = $new if $new;
 199     return $self->{configuration}->{censorship};
 200 }
 201
 202 =head3 _load_configuration
 203
 204     my $configuration = $config->_load_configuration($config_from_xml);
 205
 206 Read the configuration values passed as the parameter, and populate a hashref
 207 suitable for use with these.
 208
 209 A key task performed here is the parsing of the input in the configuration
 210 file to ensure we have only valid input there.
 211
 212 =cut
 213
 214 sub _load_configuration {
 215     my ( $xml_config, $unmediated ) = @_;
 216     my $xml_backend_dir = $xml_config->{backend_directory};
 217
 218     # Default data structure to be returned
 219     my $configuration = {
 220         backend_directory  => $xml_backend_dir,
 221         censorship         => {
 222             censor_notes_staff => 0,
 223             censor_reply_date => 0,
 224         },
 225         limits             => {},
 226         digital_recipients => {},
 227         prefixes           => {},
 228         partner_code       => 'ILLLIBS',
 229         raw_config         => $xml_config,
 230     };
 231
 232     # Per Branch Configuration
 233     my $branches = $xml_config->{branch};
 234     if ( ref($branches) eq "ARRAY" ) {
 235         # Multiple branch overrides defined
 236         map {
 237             _load_unit_config({
 238                 unit   => $_,
 239                 id     => $_->{code},
 240                 config => $configuration,
 241                 type   => 'branch'
 242             })
 243         } @{$branches};
 244     } elsif ( ref($branches) eq "HASH" ) {
 245         # Single branch override defined
 246         _load_unit_config({
 247             unit   => $branches,
 248             id     => $branches->{code},
 249             config => $configuration,
 250             type   => 'branch'
 251         });
 252     }
 253
 254     # Per Borrower Category Configuration
 255     my $brw_cats = $xml_config->{borrower_category};
 256     if ( ref($brw_cats) eq "ARRAY" ) {
 257         # Multiple borrower category overrides defined
 258         map {
 259             _load_unit_config({
 260                 unit   => $_,
 261                 id     => $_->{code},
 262                 config => $configuration,
 263                 type   => 'brw_cat'
 264             })
 265         } @{$brw_cats};
 266     } elsif ( ref($brw_cats) eq "HASH" ) {
 267         # Single branch override defined
 268         _load_unit_config({
 269             unit   => $brw_cats,
 270             id     => $brw_cats->{code},
 271             config => $configuration,
 272             type   => 'brw_cat'
 273         });
 274     }
 275
 276     # Default Configuration
 277     _load_unit_config({
 278         unit   => $xml_config,
 279         id     => 'default',
 280         config => $configuration
 281     });
 282
 283     # Censorship
 284     my $staff_comments = $xml_config->{staff_request_comments} || 0;
 285     $configuration->{censorship}->{censor_notes_staff} = 1
 286         if ( $staff_comments && 'hide' eq $staff_comments );
 287     my $reply_date = $xml_config->{reply_date} || 0;
 288     $configuration->{censorship}->{censor_reply_date} = 1
 289         if ( $reply_date && 'hide' eq $reply_date );
 290
 291     # ILL Partners
 292     $configuration->{partner_code} = $xml_config->{partner_code} || 'ILLLIBS';
 293
 294     die "No DEFAULT_FORMATS has been defined in koha-conf.xml, but UNMEDIATEDILL is active."
 295         if ( $unmediated && !$configuration->{default_formats}->{default} );
 296
 297     return $configuration;
 298 }
 299
 300 =head3 _load_unit_config
 301
 302     my $configuration->{part} = _load_unit_config($params);
 303
 304 $PARAMS is a hashref with the following elements:
 305 - unit: the part of the configuration we are parsing.
 306 - id: the name within which we will store the parsed unit in config.
 307 - config: the configuration we are augmenting.
 308 - type: the type of config unit we are parsing.  Assumed to be 'default'.
 309
 310 Read `unit', and augment `config' with these under `id'.
 311
 312 This is a helper for _load_configuration.
 313
 314 A key task performed here is the parsing of the input in the configuration
 315 file to ensure we have only valid input there.
 316
 317 =cut
 318
 319 sub _load_unit_config {
 320     my ( $params ) = @_;
 321     my $unit = $params->{unit};
 322     my $id = $params->{id};
 323     my $config = $params->{config};
 324     my $type = $params->{type};
 325     die "TYPE should be either 'branch' or 'brw_cat' if ID is not 'default'."
 326         if ( $id ne 'default' && ( $type ne 'branch' && $type ne 'brw_cat') );
 327     return $config unless $id;
 328
 329     if ( $unit->{api_key} && $unit->{api_auth} ) {
 330         $config->{credentials}->{api_keys}->{$id} = {
 331             api_key  => $unit->{api_key},
 332             api_auth => $unit->{api_auth},
 333         };
 334     }
 335     # Add request_limit rules.
 336     # METHOD := 'annual' || 'active'
 337     # COUNT  := x >= -1
 338     if ( ref $unit->{request_limit} eq 'HASH' ) {
 339         my $method  = $unit->{request_limit}->{method};
 340         my $count = $unit->{request_limit}->{count};
 341         if ( 'default' eq $id ) {
 342             $config->{limits}->{$id}->{method}  = $method
 343                 if ( $method && ( 'annual' eq $method || 'active' eq $method ) );
 344             $config->{limits}->{$id}->{count} = $count
 345                 if ( $count && ( -1 <= $count ) );
 346         } else {
 347             $config->{limits}->{$type}->{$id}->{method}  = $method
 348                 if ( $method && ( 'annual' eq $method || 'active' eq $method ) );
 349             $config->{limits}->{$type}->{$id}->{count} = $count
 350                 if ( $count && ( -1 <= $count ) );
 351         }
 352     }
 353
 354     # Add prefix rules.
 355     # PREFIX := string
 356     if ( $unit->{prefix} ) {
 357         if ( 'default' eq $id ) {
 358             $config->{prefixes}->{$id} = $unit->{prefix};
 359         } else {
 360             $config->{prefixes}->{$type}->{$id} = $unit->{prefix};
 361         }
 362     }
 363
 364     # Add digital_recipient rules.
 365     # DIGITAL_RECIPIENT := borrower || branch (defaults to borrower)
 366     if ( $unit->{digital_recipient} ) {
 367         if ( 'default' eq $id ) {
 368             $config->{digital_recipients}->{$id} = $unit->{digital_recipient};
 369         } else {
 370             $config->{digital_recipients}->{$type}->{$id} =
 371                 $unit->{digital_recipient};
 372         }
 373     }
 374
 375     return $config;
 376 }
 377
 378 =head1 AUTHOR
 379
 380 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
 381
 382 =cut
 383
 384 1;