+use LWP::UserAgent;
+use URI;
+use URI::Escape;
+use POSIX qw(strftime);
+use Encode;
+
+my $debug = 0;
+my $listen = '127.0.0.1:9000';
+$listen = ':9000';
+my $reader;
+my $koha_url = $ENV{KOHA_URL};
+warn "$koha_url";
+# internal URL so we can find local address of machine and vmware NAT
+my $rfid_url = $ENV{RFID_URL};
+my $sip2 = {
+ server => $ENV{SIP2_SERVER}, # '10.60.0.11:6002' must be IP!
+ user => $ENV{SIP2_USER},
+ password => $ENV{SIP2_PASSWORD},
+ loc => $ENV{SIP2_LOC},
+};
+my $afi = {
+ secure => 0xDA,
+ unsecure => 0xD7,
+};
+
+use Getopt::Long;
+
+GetOptions(
+ 'debug!' => \$debug,
+ 'listen=s', => \$listen,
+ 'reader=s', => \$reader,
+) || die $!;
+
+die "need KOHA_URL, eg. http://ffzg.koha-dev.rot13.org:8080" unless $koha_url;
+
+our $rfid_sid_cache;
+
+sub rfid_borrower {
+ my $hash = shift;
+ if ( my $json = $rfid_sid_cache->{ $hash->{sid} } ) {
+ return $json;
+ }
+ my $ua = LWP::UserAgent->new;
+ my $url = URI->new( $koha_url . '/cgi-bin/koha/ffzg/rfid/borrower.pl');
+ $url->query_form(
+ RFID_SID => $hash->{sid}
+ , OIB => $hash->{OIB}
+ , JMBAG => $hash->{JMBAG}
+ );
+ warn "GET ",$url->as_string;
+ my $response = $ua->get($url);
+ if ( $response->is_success ) {
+ my $json = decode_json $response->decoded_content;
+ $rfid_sid_cache->{ $hash->{sid} } = $json;
+ return $json;
+ } else {
+ warn "ERROR ", $response->status_line;
+ }
+}
+
+
+sub sip2_socket {
+
+ return $sip2->{sock} if exists $sip2->{sock} && $sip2->{sock}->connected;
+
+ if ( my $server = $sip2->{server} ) {
+ my $sock = $sip2->{sock} = IO::Socket::INET->new( $server ) || die "can't connect to $server: $!";
+ warn "SIP2 server ", $sock->peerhost, ":", $sock->peerport, "\n";
+
+ # login
+ if ( sip2_message("9300CN$sip2->{user}|CO$sip2->{password}|")->{fixed} !~ m/^941/ ) {
+ die "SIP2 login failed";
+ }
+
+ }
+ return $sip2->{sock};
+}
+
+sub sip2_message {
+ my $send = shift;
+
+ my $retry = 0;
+
+send_again:
+ my $sock = sip2_socket || die "no sip2 socket";
+
+ local $/ = "\r";
+
+ $send .= "\r" unless $send =~ m/\r$/;
+ $send .= "\n" unless $send =~ m/\n$/;
+
+ warn "SIP2 >>>> ",dump($send), "\n";
+ print $sock $send;
+ $sock->flush;
+
+ my $expect = substr($send,0,2) | 0x01;
+
+ my $in = <$sock>;
+ warn "SIP2 <<<< ",dump($in), "\n";
+
+ $in =~ s/^\n//;
+ $in =~ s/\r$//;
+
+ if ( ! $in ) {
+ $retry++;
+ warn "empty read from SIP server, retry: $retry\n";
+ if ( $retry < 10 ) {
+ close( $sip2->{sock} );
+ goto send_again;
+ }
+ die "aborted";
+ }