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