sip_cli_emulator.pl

#!/usr/bin/perl

# This file is part of Koha.
#
# Copyright (C) 2012-2013 ByWater Solutions
#
# Koha is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# Koha is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use Modern::Perl;

use Socket qw(:crlf);
use IO::Socket::INET;
use Getopt::Long;

use C4::SIP::Sip::Constants qw(:all);
use C4::SIP::Sip;

use constant { LANGUAGE => '001' };

my $help = 0;

my $host;
my $port = '6001';

my $login_user_id;
my $login_password;
my $location_code;

my $patron_identifier;
my $patron_password;

my $summary;

my $item_identifier;

my $fee_acknowledged = 0;

my $terminator = q{};

my @messages;

GetOptions(
    "a|address|host|hostaddress=s" => \$host,              # sip server ip
    "p|port=s"                     => \$port,              # sip server port
    "su|sip_user=s"                => \$login_user_id,     # sip user
    "sp|sip_pass=s"                => \$login_password,    # sip password
    "l|location|location_code=s"   => \$location_code,     # sip location code

    "patron=s"   => \$patron_identifier,                   # patron cardnumber or login
    "password=s" => \$patron_password,                     # patron's password

    "i|item=s" => \$item_identifier,

    "fa|fee-acknowledged" => \$fee_acknowledged,

    "s|summary=s" => \$summary,

    "t|terminator=s" => \$terminator,

    "m|message=s" => \@messages,

    'h|help|?' => \$help
);

if (   $help
    || !$host
    || !$login_user_id
    || !$login_password
    || !$location_code )
{
    say &help();
    exit();
}

$terminator = ( $terminator eq 'CR' ) ? $CR : $CRLF;

# Set perl to expect the same record terminator it is sending
$/ = $terminator;

my $transaction_date = C4::SIP::Sip::timestamp();

my $terminal_password = $login_password;

$| = 1;
print "Attempting socket connection to $host:$port...";

my $socket = IO::Socket::INET->new("$host:$port")
  or die "failed! : $!\n";
say "connected!";

my $handlers = {
    login => {
        name       => 'Login',
        subroutine => \&build_login_command_message,
        parameters => {
            login_user_id  => $login_user_id,
            login_password => $login_password,
            location_code  => $location_code,
        },
    },
    patron_status_request => {
        name       => 'Patron Status Request',
        subroutine => \&build_patron_status_request_command_message,
        parameters => {
            transaction_date  => $transaction_date,
            institution_id    => $location_code,
            patron_identifier => $patron_identifier,
            terminal_password => $terminal_password,
            patron_password   => $patron_password,
        },
        optional => [ 'patron_password', ],
    },
    patron_information => {
        name       => 'Patron Information',
        subroutine => \&build_patron_information_command_message,
        parameters => {
            transaction_date  => $transaction_date,
            institution_id    => $location_code,
            patron_identifier => $patron_identifier,
            terminal_password => $terminal_password,
            patron_password   => $patron_password,
            summary           => $summary,
        },
        optional => [ 'patron_password', 'summary' ],
    },
    item_information => {
        name       => 'Item Information',
        subroutine => \&build_item_information_command_message,
        parameters => {
            transaction_date  => $transaction_date,
            institution_id    => $location_code,
            item_identifier   => $item_identifier,
            terminal_password => $terminal_password,
        },
        optional => [],
    },
    checkout => {
        name       => 'Checkout',
        subroutine => \&build_checkout_command_message,
        parameters => {
            SC_renewal_policy => 'Y',
            no_block          => 'N',
            transaction_date  => $transaction_date,
            nb_due_date       => undef,
            institution_id    => $location_code,
            patron_identifier => $patron_identifier,
            item_identifier   => $item_identifier,
            terminal_password => $terminal_password,
            item_properties   => undef,
            patron_password   => $patron_password,
            fee_acknowledged  => $fee_acknowledged,
            cancel            => undef,
        },
        optional => [
            'nb_due_date',    # defaults to transaction date
            'item_properties',
            'patron_password',
            'fee_acknowledged',
            'cancel',
        ],
    },
    checkin => {
        name       => 'Checkin',
        subroutine => \&build_checkin_command_message,
        parameters => {
            no_block          => 'N',
            transaction_date  => $transaction_date,
            return_date       => $transaction_date,
            current_location  => $location_code,
            institution_id    => $location_code,
            item_identifier   => $item_identifier,
            terminal_password => $terminal_password,
            item_properties   => undef,
            cancel            => undef,
        },
        optional => [
            'return_date',    # defaults to transaction date
            'item_properties',
            'patron_password',
            'cancel',
        ],
    },
    renew => {
        name       => 'Renew',
        subroutine => \&build_renew_command_message,
        parameters => {
            third_party_allowed => 'N',
            no_block            => 'N',
            transaction_date    => $transaction_date,
            nb_due_date         => undef,
            institution_id      => $location_code,
            patron_identifier   => $patron_identifier,
            patron_password     => $patron_password,
            item_identifier     => $item_identifier,
            title_identifier    => undef,
            terminal_password   => $terminal_password,
            item_properties     => undef,
            fee_acknowledged    => $fee_acknowledged,
        },
        optional => [
            'nb_due_date',    # defaults to transaction date
            'patron_password',
            'item_identifier',
            'title_identifier',
            'terminal_password',
            'item_properties',
            'fee_acknowledged',
        ],
    },
};

my $data = run_command_message('login');

if ( $data =~ '^941' ) {    ## we are logged in
    foreach my $m (@messages) {
        say "Trying '$m'";

        my $data = run_command_message($m);

    }
}
else {
    say "Login Failed!";
}

sub build_command_message {
    my ($message) = @_;

    ##FIXME It would be much better to use exception handling so we aren't priting from subs
    unless ( $handlers->{$message} ) {
        say "$message is an unsupported command!";
        return;
    }

    my $subroutine = $handlers->{$message}->{subroutine};
    my $parameters = $handlers->{$message}->{parameters};
    my %optional   = map { $_ => 1 } @{ $handlers->{$message}->{optional} };

    foreach my $key ( keys %$parameters ) {
        unless ( $parameters->{$key} ) {
            unless ( $optional{$key} ) {
                say "$key is required for $message";
                return;
            }
        }
    }

    return &$subroutine($parameters);
}

sub run_command_message {
    my ($message) = @_;

    my $command_message = build_command_message($message);

    return unless $command_message;

    say "SEND: $command_message";
    print $socket $command_message . $terminator;

    my $data = <$socket>;

    say "READ: $data";

    return $data;
}

sub build_login_command_message {
    my ($params) = @_;

    my $login_user_id  = $params->{login_user_id};
    my $login_password = $params->{login_password};
    my $location_code  = $params->{location_code};

    return
        LOGIN . "00"
      . build_field( FID_LOGIN_UID,     $login_user_id )
      . build_field( FID_LOGIN_PWD,     $login_password )
      . build_field( FID_LOCATION_CODE, $location_code );
}

sub build_patron_status_request_command_message {
    my ($params) = @_;

    my $transaction_date  = $params->{transaction_date};
    my $institution_id    = $params->{institution_id};
    my $patron_identifier = $params->{patron_identifier};
    my $terminal_password = $params->{terminal_password};
    my $patron_password   = $params->{patron_password};

    return
        PATRON_STATUS_REQ
      . LANGUAGE
      . $transaction_date
      . build_field( FID_INST_ID,      $institution_id )
      . build_field( FID_PATRON_ID,    $patron_identifier )
      . build_field( FID_TERMINAL_PWD, $terminal_password )
      . build_field( FID_PATRON_PWD,   $patron_password );
}

sub build_patron_information_command_message {
    my ($params) = @_;

    my $transaction_date  = $params->{transaction_date};
    my $institution_id    = $params->{institution_id};
    my $patron_identifier = $params->{patron_identifier};
    my $terminal_password = $params->{terminal_password};
    my $patron_password   = $params->{patron_password};
    my $summary           = $params->{summary};

    $summary //= "          ";

    return
        PATRON_INFO
      . LANGUAGE
      . $transaction_date
      . $summary
      . build_field( FID_INST_ID,      $institution_id )
      . build_field( FID_PATRON_ID,    $patron_identifier )
      . build_field( FID_TERMINAL_PWD, $terminal_password )
      . build_field( FID_PATRON_PWD,   $patron_password, { optional => 1 } );
}

sub build_item_information_command_message {
    my ($params) = @_;

    my $transaction_date  = $params->{transaction_date};
    my $institution_id    = $params->{institution_id};
    my $item_identifier   = $params->{item_identifier};
    my $terminal_password = $params->{terminal_password};

    return
        ITEM_INFORMATION
      . LANGUAGE
      . $transaction_date
      . build_field( FID_INST_ID,      $institution_id )
      . build_field( FID_ITEM_ID,      $item_identifier )
      . build_field( FID_TERMINAL_PWD, $terminal_password );
}

sub build_checkout_command_message {
    my ($params) = @_;

    my $SC_renewal_policy = $params->{SC_renewal_policy} || 'N';
    my $no_block          = $params->{no_block} || 'N';
    my $transaction_date  = $params->{transaction_date};
    my $nb_due_date       = $params->{nb_due_date};
    my $institution_id    = $params->{institution_id};
    my $patron_identifier = $params->{patron_identifier};
    my $item_identifier   = $params->{item_identifier};
    my $terminal_password = $params->{terminal_password};
    my $item_properties   = $params->{item_properties};
    my $patron_password   = $params->{patron_password};
    my $fee_acknowledged  = $params->{fee_acknowledged} || 'N';
    my $cancel            = $params->{cancel} || 'N';

    $SC_renewal_policy = $SC_renewal_policy eq 'Y' ? 'Y' : 'N';
    $no_block          = $no_block          eq 'Y' ? 'Y' : 'N';
    $fee_acknowledged  = $fee_acknowledged  eq 'Y' ? 'Y' : 'N';
    $cancel            = $cancel            eq 'Y' ? 'Y' : 'N';

    $nb_due_date ||= $transaction_date;

    return
        CHECKOUT
      . $SC_renewal_policy
      . $no_block
      . $transaction_date
      . $nb_due_date
      . build_field( FID_INST_ID,      $institution_id )
      . build_field( FID_PATRON_ID,    $patron_identifier )
      . build_field( FID_ITEM_ID,      $item_identifier )
      . build_field( FID_TERMINAL_PWD, $terminal_password )
      . build_field( FID_ITEM_PROPS,   $item_properties, { optional => 1 } )
      . build_field( FID_PATRON_PWD,   $patron_password, { optional => 1 } )
      . build_field( FID_FEE_ACK,      $fee_acknowledged, { optional => 1 } )
      . build_field( FID_CANCEL,       $cancel, { optional => 1 } );
}

sub build_checkin_command_message {
    my ($params) = @_;

    my $no_block          = $params->{no_block} || 'N';
    my $transaction_date  = $params->{transaction_date};
    my $return_date       = $params->{return_date};
    my $current_location  = $params->{current_location};
    my $institution_id    = $params->{institution_id};
    my $item_identifier   = $params->{item_identifier};
    my $terminal_password = $params->{terminal_password};
    my $item_properties   = $params->{item_properties};
    my $cancel            = $params->{cancel} || 'N';

    $no_block = $no_block eq 'Y' ? 'Y' : 'N';
    $cancel   = $cancel   eq 'Y' ? 'Y' : 'N';

    $return_date ||= $transaction_date;

    return
        CHECKIN
      . $no_block
      . $transaction_date
      . $return_date
      . build_field( FID_CURRENT_LOCN, $current_location )
      . build_field( FID_INST_ID,      $institution_id )
      . build_field( FID_ITEM_ID,      $item_identifier )
      . build_field( FID_TERMINAL_PWD, $terminal_password )
      . build_field( FID_ITEM_PROPS,   $item_properties, { optional => 1 } )
      . build_field( FID_CANCEL,       $cancel, { optional => 1 } );
}

sub build_renew_command_message {
    my ($params) = @_;

    my $third_party_allowed = $params->{third_party_allowed} || 'N';
    my $no_block            = $params->{no_block}            || 'N';
    my $transaction_date    = $params->{transaction_date};
    my $nb_due_date         = $params->{nb_due_date};
    my $institution_id      = $params->{institution_id};
    my $patron_identifier   = $params->{patron_identifier};
    my $patron_password     = $params->{patron_password};
    my $item_identifier     = $params->{item_identifier};
    my $title_identifier    = $params->{title_identifier};
    my $terminal_password   = $params->{terminal_password};
    my $item_properties     = $params->{item_properties};
    my $fee_acknowledged    = $params->{fee_acknowledged}    || 'N';

    $third_party_allowed = $third_party_allowed eq 'Y' ? 'Y' : 'N';
    $no_block            = $no_block            eq 'Y' ? 'Y' : 'N';
    $fee_acknowledged    = $fee_acknowledged    eq 'Y' ? 'Y' : 'N';

    $nb_due_date ||= $transaction_date;

    return
        RENEW
      . $third_party_allowed
      . $no_block
      . $transaction_date
      . $nb_due_date
      . build_field( FID_INST_ID,      $institution_id )
      . build_field( FID_PATRON_ID,    $patron_identifier )
      . build_field( FID_PATRON_PWD,   $patron_password, { optional => 1 } )
      . build_field( FID_ITEM_ID,      $item_identifier )
      . build_field( FID_TITLE_ID,     $title_identifier )
      . build_field( FID_TERMINAL_PWD, $terminal_password )
      . build_field( FID_ITEM_PROPS,   $item_properties, { optional => 1 } )
      . build_field( FID_FEE_ACK,      $fee_acknowledged, { optional => 1 } );
}

sub build_field {
    my ( $field_identifier, $value, $params ) = @_;

    $params //= {};

    return q{} if ( $params->{optional} && !$value );

    return $field_identifier . (($value) ? $value : '') . '|';
}

sub help {
    say q/sip_cli_emulator.pl - SIP command line emulator

Test a SIP2 service by sending patron status and patron
information requests.

Usage:
  sip_cli_emulator.pl [OPTIONS]

Options:
  --help           display help message

  -a --address     SIP server ip address or host name
  -p --port        SIP server port

  -su --sip_user   SIP server login username
  -sp --sip_pass   SIP server login password

  -l --location    SIP location code

  --patron         ILS patron cardnumber or username
  --password       ILS patron password

  -s --summary     Optionally define the patron information request summary field.
                   Please refer to the SIP2 protocol specification for details

  --item           ILS item identifier ( item barcode )

  -t --terminator  SIP2 message terminator, either CR, or CRLF
                   (defaults to CRLF)

  -fa --fee-acknowledged Sends a confirmation of checkout fee

  -m --message     SIP2 message to execute

  Implemented Messages:
    patron_status_request
    patron_information
    item_information
    checkout
    checkin
    renew

/
}