C4/SIP/Sip/Configuration.pm

   1 #
   2 # parse-config: Parse an XML-format
   3 # ACS configuration file and build the configuration
   4 # structure.
   5 #
   6
   7 package C4::SIP::Sip::Configuration;
   8
   9 use strict;
  10 use warnings;
  11 use XML::Simple qw(:strict);
  12 use List::MoreUtils qw(uniq);
  13
  14 use C4::SIP::Sip qw(siplog);
  15 use Koha::Libraries;
  16
  17 my $parser = XML::Simple->new(
  18     KeyAttr => {
  19         login       => '+id',
  20         institution => '+id',
  21         service     => '+port'
  22     },
  23     GroupTags => {
  24         listeners    => 'service',
  25         accounts     => 'login',
  26         institutions => 'institution',
  27     },
  28     ForceArray => [ 'service', 'login', 'institution' ],
  29     ValueAttr  => {
  30         'error-detect' => 'enabled',
  31         'min_servers'  => 'value',
  32         'max_servers'  => 'value'
  33     }
  34 );
  35
  36 sub new {
  37     my ( $class, $config_file ) = @_;
  38     my $cfg = $parser->XMLin($config_file);
  39     my %listeners;
  40
  41     # The key to the listeners hash is the 'port' component of the
  42     # configuration, which is of the form '[host]:[port]/proto', and
  43     # the 'proto' component could be upper-, lower-, or mixed-cased.
  44     # Regularize it here to lower-case, and then do the same below in
  45     # find_server() when building the keys to search the hash.
  46
  47     foreach my $service ( values %{ $cfg->{listeners} } ) {
  48         $listeners{ lc $service->{port} } = $service;
  49     }
  50     $cfg->{listeners} = \%listeners;
  51
  52     my @branchcodes = Koha::Libraries->search()->get_column('branchcode');
  53     my @institutions = uniq( keys %{ $cfg->{institutions} } );
  54     foreach my $i ( @institutions ) {
  55         siplog("LOG_ERR", "ERROR: Institution $i does does not match a branchcode. This can cause unexpected behavior.") unless grep( /^$i$/, @branchcodes );
  56     }
  57
  58     return bless $cfg, $class;
  59 }
  60
  61 sub error_detect {
  62     my $self = shift;
  63     return $self->{'error-detect'};
  64 }
  65
  66 sub accounts {
  67     my $self = shift;
  68     return values %{ $self->{accounts} };
  69 }
  70
  71 sub find_service {
  72     my ( $self, $sockaddr, $port, $proto ) = @_;
  73     my $portstr;
  74     foreach my $addr ( '', '*:', "$sockaddr:", "[$sockaddr]:" ) {
  75         $portstr = sprintf( "%s%s/%s", $addr, $port, lc $proto );
  76         siplog( "LOG_DEBUG",
  77             "Configuration::find_service: Trying $portstr" );
  78         last if ( exists( ( $self->{listeners} )->{$portstr} ) );
  79     }
  80     return $self->{listeners}->{$portstr};
  81 }
  82
  83 1;