lib/NCIP/Configuration.pm

   1 package NCIP::Configuration;
   2
   3 # Copyright 2013 Catalyst IT <chrisc@catalyst.net.nz>
   4
   5 # This file is part of NCIPServer
   6 #
   7 # NCIPServer 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 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # NCIPServer 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 NCIPServer; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20
  21 =head1 NAME
  22
  23   NCIP::Configuration
  24
  25 =head1 SYNOPSIS
  26
  27   use NCIP::Configuration;
  28   my $config = NCIP::Configuration->new($config_dir);
  29
  30 =cut
  31
  32 use Modern::Perl;
  33 use NCIP::Configuration::Service;
  34 use base qw(Config::Merge);
  35
  36 sub new {
  37     my $class = shift;
  38     my $self  = $class->SUPER::new(@_);
  39     my @services;
  40
  41     # we might have a few services set them up safely
  42     if ( ref( $self->('NCIP.listeners.service') ) eq 'ARRAY' ) {
  43         @services = $self->('NCIP.listeners.service');
  44     }
  45     else {
  46         @services = ( $self->('NCIP.listeners')->{'service'} );
  47     }
  48     my %listeners;
  49     foreach my $service (@services) {
  50         my $serv_object = NCIP::Configuration::Service->new($service);
  51         $listeners{ lc $service->{'port'} } = $serv_object;
  52     }
  53     $self->{'listeners'} = \%listeners;
  54     return $self;
  55 }
  56
  57 =head1 FUNCTIONS
  58
  59 =head2 find_service
  60
  61   my $service = $config->($sockaddr, $port, $proto);
  62
  63   Used to find which service you should be using to answer an incoming request
  64
  65 =cut
  66
  67 sub find_service {
  68     my ( $self, $sockaddr, $port, $proto ) = @_;
  69     my $portstr;
  70     foreach my $addr ( '', '*:', "$sockaddr:" ) {
  71         $portstr = sprintf( "%s%s/%s", $addr, $port, lc $proto );
  72         Sys::Syslog::syslog( "LOG_DEBUG",
  73             "Configuration::find_service: Trying $portstr" );
  74         last if ( exists( ( $self->{listeners} )->{$portstr} ) );
  75     }
  76     return $self->{listeners}->{$portstr};
  77 }
  78 1;
  79