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