lib/SIP2/ACS.pm

   1 package SIP2::ACS;
   2
   3 =head1 NAME
   4
   5 SIP2::ACS - Automated Circulation System
   6
   7 =head1 DESCRIPTION
   8
   9 Basically just a simple proxy to real ACS server
  10
  11 =cut
  12
  13 use warnings;
  14 use strict;
  15
  16 use IO::Socket::INET;
  17 use IO::Select;
  18
  19 use Data::Dump qw(dump);
  20
  21 use lib 'lib';
  22 use SIP2::SC;
  23
  24 my $listen = '127.0.0.1:6001';
  25 my $server = '10.60.0.251:6001';
  26
  27 warn "listen on $listen for SIP2/RAW\n";
  28
  29 my $lsn = IO::Socket::INET->new(Listen => 1, LocalAddr => $listen, Reuse => 1) or die $!;
  30 my $sel = IO::Select->new($lsn);
  31
  32 our $sc;
  33
  34 local $/ = "\r";
  35
  36 while (1) {
  37         for my $sock ($sel->can_read(1)) {
  38
  39                 if ($sock == $lsn) {
  40                         my $new = $lsn->accept;
  41                         my $ip = $sock->peerhost;
  42                         warn "connection from $ip\n";
  43                         $sel->add($new);
  44                 } else {
  45                         my $line = <$sock>;
  46                         if ( ! defined $line ) {
  47                                 warn "disconnect from ", $sock->peerhost;
  48                                 $sel->remove( $sock );
  49                                 delete( $sc->{$sock} );
  50                                 close($sock);
  51                                 next;
  52                         }
  53                         my $ip = $sock->peerhost;
  54                         warn "<< $ip ", dump($line);
  55                         if ( ! $sc->{$sock} ) {
  56                                 warn "connect to $server for $sock\n";
  57                                 $sc->{$sock} = SIP2::SC->new( $server );
  58                         }
  59                         $line .= "\n"; # lf to fix Koha ACS
  60                         print $sock $sc->{$sock}->message( $line )
  61                 }
  62         }
  63 }
  64
  65 1;
  66