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