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
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  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   $backends = $config->available_backends;
 108   $backends = $config->abailable_backends($reduced);
 109
 110 Return a list of available backends, if passed a | delimited list it
 111 will filter those backends down to only those present in the list.
 112
 113 =cut
 114
 115 sub available_backends {
 116     my ( $self, $reduce ) = @_;
 117     my $backend_dir = $self->backend_dir;
 118     my @backends = ();
 119     @backends = glob "$backend_dir/*" if ( $backend_dir );
 120     @backends = map { basename($_) } @backends;
 121     @backends = grep { $_ =~ /$reduce/ } @backends if $reduce;
 122     return \@backends;
 123 }
 124
 125 =head3 has_branch
 126
 127 Return whether a 'branch' block is defined
 128
 129 =cut
 130
 131 sub has_branch {
 132     my ( $self ) = @_;
 133     return $self->{configuration}->{raw_config}->{branch};
 134 }
 135
 136 =head3 partner_code
 137
 138     $partner_code = $config->partner_code($new_code);
 139     $partner_code = $config->partner_code;
 140
 141 Standard setter/accessor for our partner_code.
 142
 143 =cut
 144
 145 sub partner_code {
 146     my ( $self, $new ) = @_;
 147     $self->{configuration}->{partner_code} = $new if $new;
 148     return $self->{configuration}->{partner_code};
 149 }
 150
 151 =head3 limits
 152
 153     $limits = $config->limits($limitshash);
 154     $limits = $config->limits;
 155
 156 Standard setter/accessor for our limits.  No parsing is performed on
 157 $LIMITSHASH, so caution should be exercised when using this setter.
 158
 159 =cut
 160
 161 sub limits {
 162     my ( $self, $new ) = @_;
 163     $self->{configuration}->{limits} = $new if $new;
 164     return $self->{configuration}->{limits};
 165 }
 166
 167 =head3 getPrefixes
 168
 169     my $prefixes = $config->getPrefixes();
 170
 171 Return the branch prefix for ILLs defined by our config.
 172
 173 =cut
 174
 175 sub getPrefixes {
 176     my ( $self ) = @_;
 177     return $self->{configuration}->{prefixes}->{branch};
 178 }
 179
 180 =head3 getLimitRules
 181
 182     my $rules = $config->getLimitRules('brw_cat' | 'branch')
 183
 184 Return the hash of ILL limit rules defined by our config.
 185
 186 =cut
 187
 188 sub getLimitRules {
 189     my ( $self, $type ) = @_;
 190     die "Unexpected type." unless ( $type eq 'brw_cat' || $type eq 'branch' );
 191     my $values = $self->{configuration}->{limits}->{$type};
 192     $values->{default} = $self->{configuration}->{limits}->{default};
 193     return $values;
 194 }
 195
 196 =head3 getDigitalRecipients
 197
 198     my $recipient_rules= $config->getDigitalRecipients('brw_cat' | 'branch');
 199
 200 Return the hash of digital_recipient settings defined by our config.
 201
 202 =cut
 203
 204 sub getDigitalRecipients {
 205     my ( $self, $type ) = @_;
 206     die "Unexpected type." unless ( $type eq 'brw_cat' || $type eq 'branch' );
 207     my $values = $self->{configuration}->{digital_recipients}->{$type};
 208     $values->{default} =
 209         $self->{configuration}->{digital_recipients}->{default};
 210     return $values;
 211 }
 212
 213 =head3 censorship
 214
 215     my $censoredValues = $config->censorship($hash);
 216     my $censoredValues = $config->censorship;
 217
 218 Standard setter/accessor for our limits.  No parsing is performed on $HASH, so
 219 caution should be exercised when using this setter.
 220
 221 Return our censorship values for the OPAC as loaded from the koha-conf.xml, or
 222 the fallback value (no censorship).
 223
 224 =cut
 225
 226 sub censorship {
 227     my ( $self, $new ) = @_;
 228     $self->{configuration}->{censorship} = $new if $new;
 229     return $self->{configuration}->{censorship};
 230 }
 231
 232 =head3 _load_configuration
 233
 234     my $configuration = $config->_load_configuration($config_from_xml);
 235
 236 Read the configuration values passed as the parameter, and populate a hashref
 237 suitable for use with these.
 238
 239 A key task performed here is the parsing of the input in the configuration
 240 file to ensure we have only valid input there.
 241
 242 =cut
 243
 244 sub _load_configuration {
 245     my ( $xml_config ) = @_;
 246     my $xml_backend_dir = $xml_config->{backend_directory};
 247
 248     # Default data structure to be returned
 249     my $configuration = {
 250         backend_directory  => $xml_backend_dir,
 251         censorship         => {
 252             censor_notes_staff => 0,
 253             censor_reply_date => 0,
 254         },
 255         limits             => {},
 256         digital_recipients => {},
 257         prefixes           => {},
 258         partner_code       => 'ILLLIBS',
 259         raw_config         => $xml_config,
 260     };
 261
 262     # Per Branch Configuration
 263     my $branches = $xml_config->{branch};
 264     if ( ref($branches) eq "ARRAY" ) {
 265         # Multiple branch overrides defined
 266         map {
 267             _load_unit_config({
 268                 unit   => $_,
 269                 id     => $_->{code},
 270                 config => $configuration,
 271                 type   => 'branch'
 272             })
 273         } @{$branches};
 274     } elsif ( ref($branches) eq "HASH" ) {
 275         # Single branch override defined
 276         _load_unit_config({
 277             unit   => $branches,
 278             id     => $branches->{code},
 279             config => $configuration,
 280             type   => 'branch'
 281         });
 282     }
 283
 284     # Per Borrower Category Configuration
 285     my $brw_cats = $xml_config->{borrower_category};
 286     if ( ref($brw_cats) eq "ARRAY" ) {
 287         # Multiple borrower category overrides defined
 288         map {
 289             _load_unit_config({
 290                 unit   => $_,
 291                 id     => $_->{code},
 292                 config => $configuration,
 293                 type   => 'brw_cat'
 294             })
 295         } @{$brw_cats};
 296     } elsif ( ref($brw_cats) eq "HASH" ) {
 297         # Single branch override defined
 298         _load_unit_config({
 299             unit   => $brw_cats,
 300             id     => $brw_cats->{code},
 301             config => $configuration,
 302             type   => 'brw_cat'
 303         });
 304     }
 305
 306     # Default Configuration
 307     _load_unit_config({
 308         unit   => $xml_config,
 309         id     => 'default',
 310         config => $configuration
 311     });
 312
 313     # Censorship
 314     my $staff_comments = $xml_config->{staff_request_comments} || 0;
 315     $configuration->{censorship}->{censor_notes_staff} = 1
 316         if ( $staff_comments && 'hide' eq $staff_comments );
 317     my $reply_date = $xml_config->{reply_date} || 0;
 318     $configuration->{censorship}->{censor_reply_date} = 1
 319         if ( $reply_date && 'hide' eq $reply_date );
 320
 321     # ILL Partners
 322     $configuration->{partner_code} = $xml_config->{partner_code} || 'ILLLIBS';
 323
 324     return $configuration;
 325 }
 326
 327 =head3 _load_unit_config
 328
 329     my $configuration->{part} = _load_unit_config($params);
 330
 331 $PARAMS is a hashref with the following elements:
 332 - unit: the part of the configuration we are parsing.
 333 - id: the name within which we will store the parsed unit in config.
 334 - config: the configuration we are augmenting.
 335 - type: the type of config unit we are parsing.  Assumed to be 'default'.
 336
 337 Read `unit', and augment `config' with these under `id'.
 338
 339 This is a helper for _load_configuration.
 340
 341 A key task performed here is the parsing of the input in the configuration
 342 file to ensure we have only valid input there.
 343
 344 =cut
 345
 346 sub _load_unit_config {
 347     my ( $params ) = @_;
 348     my $unit = $params->{unit};
 349     my $id = $params->{id};
 350     my $config = $params->{config};
 351     my $type = $params->{type};
 352     die "TYPE should be either 'branch' or 'brw_cat' if ID is not 'default'."
 353         if ( $id ne 'default' && ( $type ne 'branch' && $type ne 'brw_cat') );
 354     return $config unless $id;
 355
 356     if ( $unit->{api_key} && $unit->{api_auth} ) {
 357         $config->{credentials}->{api_keys}->{$id} = {
 358             api_key  => $unit->{api_key},
 359             api_auth => $unit->{api_auth},
 360         };
 361     }
 362     # Add request_limit rules.
 363     # METHOD := 'annual' || 'active'
 364     # COUNT  := x >= -1
 365     if ( ref $unit->{request_limit} eq 'HASH' ) {
 366         my $method  = $unit->{request_limit}->{method};
 367         my $count = $unit->{request_limit}->{count};
 368         if ( 'default' eq $id ) {
 369             $config->{limits}->{$id}->{method}  = $method
 370                 if ( $method && ( 'annual' eq $method || 'active' eq $method ) );
 371             $config->{limits}->{$id}->{count} = $count
 372                 if ( $count && ( -1 <= $count ) );
 373         } else {
 374             $config->{limits}->{$type}->{$id}->{method}  = $method
 375                 if ( $method && ( 'annual' eq $method || 'active' eq $method ) );
 376             $config->{limits}->{$type}->{$id}->{count} = $count
 377                 if ( $count && ( -1 <= $count ) );
 378         }
 379     }
 380
 381     # Add prefix rules.
 382     # PREFIX := string
 383     if ( $unit->{prefix} ) {
 384         if ( 'default' eq $id ) {
 385             $config->{prefixes}->{$id} = $unit->{prefix};
 386         } else {
 387             $config->{prefixes}->{$type}->{$id} = $unit->{prefix};
 388         }
 389     }
 390
 391     # Add digital_recipient rules.
 392     # DIGITAL_RECIPIENT := borrower || branch (defaults to borrower)
 393     if ( $unit->{digital_recipient} ) {
 394         if ( 'default' eq $id ) {
 395             $config->{digital_recipients}->{$id} = $unit->{digital_recipient};
 396         } else {
 397             $config->{digital_recipients}->{$type}->{$id} =
 398                 $unit->{digital_recipient};
 399         }
 400     }
 401
 402     return $config;
 403 }
 404
 405 =head1 AUTHOR
 406
 407 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
 408
 409 =cut
 410
 411 1;