Attachment 170340 Details for Bug 37543 – Bug 37543: (follow-up) Tidy

[patch] Bug 37543: (follow-up) Tidy

Bug-37543-follow-up-Tidy.patch (text/plain), 23.96 KB, created by Paul Derscheid on 2024-08-15 09:01:07 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Paul Derscheid

Created: 2024-08-15 09:01:07 UTC

Size: 23.96 KB

patch

obsolete

>From f5cb58c03d2b4d4f8555fefd86fd5dd68b460b53 Mon Sep 17 00:00:00 2001
>From: Nick Clemens <nick@bywatersolutions.com>
>Date: Fri, 9 Aug 2024 10:58:23 +0000
>Subject: [PATCH] Bug 37543: (follow-up) Tidy
>
>Tidy the whole thing
>
>Signed-off-by: Nick Clemens <nick@bywatersolutions.com>
>Signed-off-by: Paul Derscheid <paul.derscheid@lmscloud.de>
>---
> misc/bin/connexion_import_daemon.pl | 638 ++++++++++++++--------------
> 1 file changed, 321 insertions(+), 317 deletions(-)
>
>diff --git a/misc/bin/connexion_import_daemon.pl b/misc/bin/connexion_import_daemon.pl
>index a4754a8229..0ab2da42ab 100755
>--- a/misc/bin/connexion_import_daemon.pl
>+++ b/misc/bin/connexion_import_daemon.pl
>@@ -22,12 +22,12 @@ use warnings;
> 
> use Getopt::Long qw( GetOptions );
> 
>-my ($help, $config, $daemon);
>+my ( $help, $config, $daemon );
> 
> GetOptions(
>-    'config|c=s'    => \$config,
>-    'daemon|d'      => \$daemon,
>-    'help|?'        => \$help,
>+    'config|c=s' => \$config,
>+    'daemon|d'   => \$daemon,
>+    'help|?'     => \$help,
> );
> 
> if ( $help || !$config ) {
>@@ -86,372 +86,376 @@ if ($daemon) {
> exit;
> 
> {
>-package ImportProxyServer;
>-
>-use Carp qw( croak );
>-use IO::Socket::INET qw( SOCK_STREAM );
>-# use IO::Socket::IP;
>-use IO::Select;
>-use POSIX;
>-use HTTP::Status qw( HTTP_FORBIDDEN HTTP_UNAUTHORIZED );
>-use strict;
>-use warnings;
> 
>-use LWP::UserAgent;
>-use XML::Simple qw( XMLin );
>-use MARC::Record;
>-use MARC::File::XML;
>+    package ImportProxyServer;
> 
>-use constant CLIENT_READ_TIMEOUT     => 5;
>-use constant CLIENT_READ_BUFFER_SIZE => 100000;
>-use constant AUTH_URI       => "/cgi-bin/koha/svc/authentication";
>-use constant IMPORT_SVC_URI => "/cgi-bin/koha/svc/import_bib";
>+    use Carp             qw( croak );
>+    use IO::Socket::INET qw( SOCK_STREAM );
> 
>-sub new {
>-    my $class = shift;
>-    my $config_file = shift or croak "No config file";
>+    # use IO::Socket::IP;
>+    use IO::Select;
>+    use POSIX;
>+    use HTTP::Status qw( HTTP_FORBIDDEN HTTP_UNAUTHORIZED );
>+    use strict;
>+    use warnings;
> 
>-    my $self = {time_to_die => 0, config_file => $config_file };
>-    bless $self, $class;
>+    use LWP::UserAgent;
>+    use XML::Simple qw( XMLin );
>+    use MARC::Record;
>+    use MARC::File::XML;
> 
>-    $self->parse_config;
>-    return $self;
>-}
>+    use constant CLIENT_READ_TIMEOUT     => 5;
>+    use constant CLIENT_READ_BUFFER_SIZE => 100000;
>+    use constant AUTH_URI                => "/cgi-bin/koha/svc/authentication";
>+    use constant IMPORT_SVC_URI          => "/cgi-bin/koha/svc/import_bib";
> 
>-sub parse_config {
>-    my $self = shift;
>+    sub new {
>+        my $class       = shift;
>+        my $config_file = shift or croak "No config file";
> 
>-    my $config_file = $self->{config_file};
>+        my $self = { time_to_die => 0, config_file => $config_file };
>+        bless $self, $class;
> 
>-    open (my $conf_fh, '<', $config_file) or die "Cannot open config file $config: $!";
>+        $self->parse_config;
>+        return $self;
>+    }
> 
>-    my %param;
>-    my $line = 0;
>-    while (<$conf_fh>) {
>-        $line++;
>-        chomp;
>-        s/\s*#.*//o; # remove comments
>-        s/^\s+//o;   # trim leading spaces
>-        s/\s+$//o;   # trim trailing spaces
>-        next unless $_;
>+    sub parse_config {
>+        my $self = shift;
> 
>-        my ($p, $v) = m/(\S+?):\s*(.*)/o;
>-        die "Invalid config line $line: $_" unless defined $v;
>-        $param{$p} = $v;
>-    }
>-    close($conf_fh);
>-
>-    $self->{koha} = delete( $param{koha} )
>-      or die "No koha base url in config file";
>-    $self->{user} = delete( $param{user} )
>-      or die "No koha user in config file";
>-    $self->{password} = delete( $param{password} )
>-      or die "No koha user password in config file";
>-
>-    if( defined $param{connexion_user} || defined $param{connexion_password}){
>-        # If either is defined we expect both
>-        $self->{connexion_user} = delete( $param{connexion_user} )
>-          or die "No koha connexion_user in config file";
>-        $self->{connexion_password} = delete( $param{connexion_password} )
>-          or die "No koha user connexion_password in config file";
>-    }
>+        my $config_file = $self->{config_file};
> 
>-    $self->{host} = delete( $param{host} );
>-    $self->{port} = delete( $param{port} )
>-      or die "Port not specified";
>+        open( my $conf_fh, '<', $config_file ) or die "Cannot open config file $config: $!";
> 
>-    $self->{debug} = delete( $param{debug} );
>+        my %param;
>+        my $line = 0;
>+        while (<$conf_fh>) {
>+            $line++;
>+            chomp;
>+            s/\s*#.*//o;    # remove comments
>+            s/^\s+//o;      # trim leading spaces
>+            s/\s+$//o;      # trim trailing spaces
>+            next unless $_;
> 
>-    my $log_fh;
>-    close $self->{log_fh} if $self->{log_fh};
>-    if (my $logfile = delete $param{log}) {
>-        open ($log_fh, '>>', $logfile) or die "Cannot open $logfile for write: $!";
>-    } else {
>-        $log_fh = \*STDERR;
>-    }
>-    $self->{log_fh} = $log_fh;
>+            my ( $p, $v ) = m/(\S+?):\s*(.*)/o;
>+            die "Invalid config line $line: $_" unless defined $v;
>+            $param{$p} = $v;
>+        }
>+        close($conf_fh);
>+
>+        $self->{koha} = delete( $param{koha} )
>+            or die "No koha base url in config file";
>+        $self->{user} = delete( $param{user} )
>+            or die "No koha user in config file";
>+        $self->{password} = delete( $param{password} )
>+            or die "No koha user password in config file";
>+
>+        if ( defined $param{connexion_user} || defined $param{connexion_password} ) {
>+
>+            # If either is defined we expect both
>+            $self->{connexion_user} = delete( $param{connexion_user} )
>+                or die "No koha connexion_user in config file";
>+            $self->{connexion_password} = delete( $param{connexion_password} )
>+                or die "No koha user connexion_password in config file";
>+        }
> 
>-    $self->{params} = \%param;
>-}
>+        $self->{host} = delete( $param{host} );
>+        $self->{port} = delete( $param{port} )
>+            or die "Port not specified";
> 
>-sub log {
>-    my $self = shift;
>-    my $log_fh = $self->{log_fh}
>-      or warn "No log fh",
>-         return;
>-    my $t = localtime;
>-    print $log_fh map "$t: $_\n", @_;
>-}
>+        $self->{debug} = delete( $param{debug} );
> 
>-sub background {
>-    my $self = shift;
>+        my $log_fh;
>+        close $self->{log_fh} if $self->{log_fh};
>+        if ( my $logfile = delete $param{log} ) {
>+            open( $log_fh, '>>', $logfile ) or die "Cannot open $logfile for write: $!";
>+        } else {
>+            $log_fh = \*STDERR;
>+        }
>+        $self->{log_fh} = $log_fh;
> 
>-    my $pid = fork;
>-    return ($pid) if $pid; # parent
>+        $self->{params} = \%param;
>+    }
> 
>-    die "Couldn't fork: $!" unless defined($pid);
>+    sub log {
>+        my $self   = shift;
>+        my $log_fh = $self->{log_fh}
>+            or warn "No log fh",
>+            return;
>+        my $t = localtime;
>+        print $log_fh map "$t: $_\n", @_;
>+    }
> 
>-    POSIX::setsid() or die "Can't start a new session: $!";
>+    sub background {
>+        my $self = shift;
> 
>-    $SIG{INT} = $SIG{TERM} = $SIG{HUP} = sub { $self->{time_to_die} = 1 };
>-    # trap or ignore $SIG{PIPE}
>-    $SIG{USR1} = sub { $self->parse_config };
>+        my $pid = fork;
>+        return ($pid) if $pid;    # parent
> 
>-    $self->run;
>-}
>+        die "Couldn't fork: $!" unless defined($pid);
> 
>-sub run {
>-    my $self = shift;
>-
>-    my $server_port = $self->{port};
>-    my $server_host = $self->{host};
>-
>-    my $server = IO::Socket::INET->new(
>-        LocalHost => $server_host,
>-        LocalPort => $server_port,
>-        Type      => SOCK_STREAM,
>-        Proto     => "tcp",
>-        Listen    => 12,
>-        Blocking  => 1,
>-        ReuseAddr => 1,
>-    ) or die "Couldn't be a tcp server on port $server_port: $! $@";
>-
>-    $self->log("Started tcp listener on $server_host:$server_port");
>-
>-    $self->{ua} = _ua();
>-
>-    while ("FOREVER") {
>-        my $client = $server->accept()
>-          or die "Cannot accept: $!";
>-        my $oldfh = select($client);
>-        $self->handle_request($client);
>-        select($oldfh);
>-        last if $self->{time_to_die};
>-    }
>+        POSIX::setsid() or die "Can't start a new session: $!";
> 
>-    close($server);
>-}
>+        $SIG{INT} = $SIG{TERM} = $SIG{HUP} = sub { $self->{time_to_die} = 1 };
> 
>-sub _ua {
>-    my $ua = LWP::UserAgent->new;
>-    $ua->timeout(10);
>-    $ua->cookie_jar({});
>-    return $ua;
>-}
>+        # trap or ignore $SIG{PIPE}
>+        $SIG{USR1} = sub { $self->parse_config };
> 
>-sub get_current_csrf_token {
>-    my $self = shift;
>-    my $ua = $self->{ua};
>-    my $url = $self->{koha} . AUTH_URI;
>-    return $ua->get($url)->header('CSRF-TOKEN');
>-}
>+        $self->run;
>+    }
> 
>-sub authenticate {
>-    my $self = shift;
>-    my $ua = $self->{ua};
>-    my $url = $self->{koha} . AUTH_URI;
>-    my $resp = $ua->post(
>-        $url,
>-        {
>-            login_userid => $self->{user},
>-            login_password => $self->{password},
>-            csrf_token => $self->get_current_csrf_token,
>+    sub run {
>+        my $self = shift;
>+
>+        my $server_port = $self->{port};
>+        my $server_host = $self->{host};
>+
>+        my $server = IO::Socket::INET->new(
>+            LocalHost => $server_host,
>+            LocalPort => $server_port,
>+            Type      => SOCK_STREAM,
>+            Proto     => "tcp",
>+            Listen    => 12,
>+            Blocking  => 1,
>+            ReuseAddr => 1,
>+        ) or die "Couldn't be a tcp server on port $server_port: $! $@";
>+
>+        $self->log("Started tcp listener on $server_host:$server_port");
>+
>+        $self->{ua} = _ua();
>+
>+        while ("FOREVER") {
>+            my $client = $server->accept()
>+                or die "Cannot accept: $!";
>+            my $oldfh = select($client);
>+            $self->handle_request($client);
>+            select($oldfh);
>+            last if $self->{time_to_die};
>         }
>-    );
>-    if ( !$resp->is_success ) {
>-        $self->log("Authentication failed", $resp->request->as_string, $resp->as_string);
>-        return;
>+
>+        close($server);
>     }
>-    return $resp->header('CSRF-TOKEN');
>-}
> 
>-sub read_request {
>-    my ( $self, $io ) = @_;
>+    sub _ua {
>+        my $ua = LWP::UserAgent->new;
>+        $ua->timeout(10);
>+        $ua->cookie_jar( {} );
>+        return $ua;
>+    }
> 
>-    my ($in, @in_arr, $timeout, $bad_marc);
>-    my $select = IO::Select->new($io) ;
>-    while ( "FOREVER" ) {
>-        if ( $select->can_read(CLIENT_READ_TIMEOUT) ){
>-            $io->recv($in, CLIENT_READ_BUFFER_SIZE);
>-            last unless $in;
>+    sub get_current_csrf_token {
>+        my $self = shift;
>+        my $ua   = $self->{ua};
>+        my $url  = $self->{koha} . AUTH_URI;
>+        return $ua->get($url)->header('CSRF-TOKEN');
>+    }
> 
>-            # XXX ignore after NULL
>-            if ( $in =~ m/^(.*)\000/so ) { # null received, EOT
>-                push @in_arr, $1;
>-                last;
>+    sub authenticate {
>+        my $self = shift;
>+        my $ua   = $self->{ua};
>+        my $url  = $self->{koha} . AUTH_URI;
>+        my $resp = $ua->post(
>+            $url,
>+            {
>+                login_userid   => $self->{user},
>+                login_password => $self->{password},
>+                csrf_token     => $self->get_current_csrf_token,
>             }
>-            push @in_arr, $in;
>-        }
>-        else {
>-            last;
>+        );
>+        if ( !$resp->is_success ) {
>+            $self->log( "Authentication failed", $resp->request->as_string, $resp->as_string );
>+            return;
>         }
>+        return $resp->header('CSRF-TOKEN');
>     }
> 
>-    $in = join '', @in_arr;
>-    $in =~ m/(.)$/;
>-    my $lastchar = $1;
>-    my ($xml, $user, $password, $local_user);
>-    my $data = $in; # copy for diagmostic purposes
>-    while () {
>-        my $first = substr( $data, 0, 1 );
>-        if (!defined $first) {
>-           last;
>-        }
>-        $first eq 'U' && do {
>-            ($user, $data) = _trim_identifier($data);
>-            next;
>-        };
>-        $first eq 'A' && do {
>-            ($local_user, $data) = _trim_identifier($data);
>-            next;
>-        };
>-        $first eq 'P' && do {
>-            ($password, $data) = _trim_identifier($data);
>-            next;
>-        };
>-        $first eq ' ' && do {
>-            $data = substr( $data, 1 ); # trim
>-            next;
>-        };
>-        $data =~ m/^[0-9]/ && do {
>-            # What we have here might be a MARC record...
>-            my $marc_record;
>-            eval { $marc_record = MARC::Record->new_from_usmarc($data); };
>-            if ($@) {
>-                $bad_marc = 1;
>+    sub read_request {
>+        my ( $self, $io ) = @_;
>+
>+        my ( $in, @in_arr, $timeout, $bad_marc );
>+        my $select = IO::Select->new($io);
>+        while ("FOREVER") {
>+            if ( $select->can_read(CLIENT_READ_TIMEOUT) ) {
>+                $io->recv( $in, CLIENT_READ_BUFFER_SIZE );
>+                last unless $in;
>+
>+                # XXX ignore after NULL
>+                if ( $in =~ m/^(.*)\000/so ) {    # null received, EOT
>+                    push @in_arr, $1;
>+                    last;
>+                }
>+                push @in_arr, $in;
>+            } else {
>+                last;
>             }
>-            else {
>-               $xml = $marc_record->as_xml();
>+        }
>+
>+        $in = join '', @in_arr;
>+        $in =~ m/(.)$/;
>+        my $lastchar = $1;
>+        my ( $xml, $user, $password, $local_user );
>+        my $data = $in;    # copy for diagmostic purposes
>+        while () {
>+            my $first = substr( $data, 0, 1 );
>+            if ( !defined $first ) {
>+                last;
>             }
>-            last;
>-        };
>-        last; # unexpected input
>-    }
>+            $first eq 'U' && do {
>+                ( $user, $data ) = _trim_identifier($data);
>+                next;
>+            };
>+            $first eq 'A' && do {
>+                ( $local_user, $data ) = _trim_identifier($data);
>+                next;
>+            };
>+            $first eq 'P' && do {
>+                ( $password, $data ) = _trim_identifier($data);
>+                next;
>+            };
>+            $first eq ' ' && do {
>+                $data = substr( $data, 1 );    # trim
>+                next;
>+            };
>+            $data =~ m/^[0-9]/ && do {
>+
>+                # What we have here might be a MARC record...
>+                my $marc_record;
>+                eval { $marc_record = MARC::Record->new_from_usmarc($data); };
>+                if ($@) {
>+                    $bad_marc = 1;
>+                } else {
>+                    $xml = $marc_record->as_xml();
>+                }
>+                last;
>+            };
>+            last;    # unexpected input
>+        }
> 
>-    my @details;
>-    push @details, "Timeout" if $timeout;
>-    push @details, "Bad MARC" if $bad_marc;
>-    push @details, "User: $user" if $user;
>-    push @details, "Password: " . ( $self->{debug} ? $password : ("x" x length($password)) ) if $password;
>-    push @details, "Local user: $local_user" if $local_user;
>-    push @details, "XML: $xml" if $xml;
>-    push @details, "Remaining data: $data" if ($data && !$xml);
>-    unless ($xml) {
>-        $self->log("Invalid request", $in, @details);
>-        return;
>+        my @details;
>+        push @details, "Timeout"                                                                   if $timeout;
>+        push @details, "Bad MARC"                                                                  if $bad_marc;
>+        push @details, "User: $user"                                                               if $user;
>+        push @details, "Password: " . ( $self->{debug} ? $password : ( "x" x length($password) ) ) if $password;
>+        push @details, "Local user: $local_user"                                                   if $local_user;
>+        push @details, "XML: $xml"                                                                 if $xml;
>+        push @details, "Remaining data: $data" if ( $data && !$xml );
>+
>+        unless ($xml) {
>+            $self->log( "Invalid request", $in, @details );
>+            return;
>+        }
>+        $user = $local_user if !$user && $local_user;
>+
>+        $self->log( "Request", @details );
>+        $self->log($in) if $self->{debug};
>+        return ( $xml, $user, $password );
>     }
>-    $user = $local_user if !$user && $local_user;
> 
>-    $self->log("Request", @details);
>-    $self->log($in) if $self->{debug};
>-    return ($xml, $user, $password);
>-}
>+    sub _trim_identifier {
> 
>-sub _trim_identifier {
>-    #my ($a, $len) = unpack "cc", substr( $_[0], 0, 2 );
>-    my $len=ord(substr ($_[0], 1, 1)) - 64;
>-    if ($len <0) {  #length is numeric, and thus comes from the web client, not the desktop client.
>-       $_[0] =~ m/.(\d+)/;
>-       $len = $1;
>-       return ( substr( $_[0], length($len)+1 , $len ), substr( $_[0], length($len) + 1 + $len ) );
>+        #my ($a, $len) = unpack "cc", substr( $_[0], 0, 2 );
>+        my $len = ord( substr( $_[0], 1, 1 ) ) - 64;
>+        if ( $len < 0 ) {    #length is numeric, and thus comes from the web client, not the desktop client.
>+            $_[0] =~ m/.(\d+)/;
>+            $len = $1;
>+            return ( substr( $_[0], length($len) + 1, $len ), substr( $_[0], length($len) + 1 + $len ) );
>+        }
>+        return ( substr( $_[0], 2, $len ), substr( $_[0], 2 + $len ) );
>     }
>-    return ( substr( $_[0], 2 , $len ), substr( $_[0], 2 + $len ) );
>-}
> 
>-sub handle_request {
>-    my ( $self, $io ) = @_;
>-    my ($data, $user, $password) = $self->read_request($io)
>-      or return $self->error_response("Bad request");
>+    sub handle_request {
>+        my ( $self, $io ) = @_;
>+        my ( $data, $user, $password ) = $self->read_request($io)
>+            or return $self->error_response("Bad request");
> 
>-    unless(
>-        !(defined $self->{connexion_user}) ||
>-        ($user eq $self->{connexion_user} && $password eq $self->{connexion_password})
>-    ){
>-       return $self->error_response("Unauthorized request");
>-    }
>+        unless ( !( defined $self->{connexion_user} )
>+            || ( $user eq $self->{connexion_user} && $password eq $self->{connexion_password} ) )
>+        {
>+            return $self->error_response("Unauthorized request");
>+        }
> 
>-    my $ua;
>-    if ($self->{user}) {
>-        $user = $self->{user};
>-        $password = $self->{password};
>-        $ua = $self->{ua};
>-    }
>-    else {
>-        $ua  = _ua(); # fresh one, needs to authenticate
>-    }
>+        my $ua;
>+        if ( $self->{user} ) {
>+            $user     = $self->{user};
>+            $password = $self->{password};
>+            $ua       = $self->{ua};
>+        } else {
>+            $ua = _ua();    # fresh one, needs to authenticate
>+        }
>+
>+        my $base_url  = $self->{koha};
>+        my $post_body = {
>+            'nomatch_action'    => $self->{params}->{nomatch_action},
>+            'overlay_action'    => $self->{params}->{overlay_action},
>+            'match'             => $self->{params}->{match},
>+            'import_mode'       => $self->{params}->{import_mode},
>+            'framework'         => $self->{params}->{framework},
>+            'overlay_framework' => $self->{params}->{overlay_framework},
>+            'item_action'       => $self->{params}->{item_action},
>+            'xml'               => $data
>+        };
> 
>-    my $base_url = $self->{koha};
>-    my $post_body = {
>-        'nomatch_action'    => $self->{params}->{nomatch_action},
>-        'overlay_action'    => $self->{params}->{overlay_action},
>-        'match'             => $self->{params}->{match},
>-        'import_mode'       => $self->{params}->{import_mode},
>-        'framework'         => $self->{params}->{framework},
>-        'overlay_framework' => $self->{params}->{overlay_framework},
>-        'item_action'       => $self->{params}->{item_action},
>-        'xml'               => $data
>-    };
>-
>-    # If we have a token, try it, else, authenticate for the first time.
>-    $self->{csrf_token} = $self->authenticate unless $self->{csrf_token};
>-    my $resp = $ua->post(
>-        $base_url . IMPORT_SVC_URI,
>-        $post_body,
>-        csrf_token => $self->{csrf_token},
>-    );
>-
>-    my $status = $resp->code;
>-    if ( $status == HTTP_UNAUTHORIZED || $status == HTTP_FORBIDDEN ) {
>-        # Our token might have expired. Re-authenticate and post again.
>-        $self->{csrf_token} = $self->authenticate;
>-        $resp = $ua->post(
>+        # If we have a token, try it, else, authenticate for the first time.
>+        $self->{csrf_token} = $self->authenticate unless $self->{csrf_token};
>+        my $resp = $ua->post(
>             $base_url . IMPORT_SVC_URI,
>             $post_body,
>             csrf_token => $self->{csrf_token},
>-        )
>-    }
>-    unless ($resp->is_success) {
>-        $self->log("Unsuccessful request", $resp->request->as_string, $resp->as_string);
>-        return $self->error_response("Unsuccessful request");
>-    }
>+        );
>+
>+        my $status = $resp->code;
>+        if ( $status == HTTP_UNAUTHORIZED || $status == HTTP_FORBIDDEN ) {
>+
>+            # Our token might have expired. Re-authenticate and post again.
>+            $self->{csrf_token} = $self->authenticate;
>+            $resp = $ua->post(
>+                $base_url . IMPORT_SVC_URI,
>+                $post_body,
>+                csrf_token => $self->{csrf_token},
>+            );
>+        }
>+        unless ( $resp->is_success ) {
>+            $self->log( "Unsuccessful request", $resp->request->as_string, $resp->as_string );
>+            return $self->error_response("Unsuccessful request");
>+        }
> 
>-    my ($koha_status, $bib, $overlay, $batch_id, $error, $url);
>-    if ( my $r = eval { XMLin($resp->content) } ) {
>-        $koha_status = $r->{status};
>-        $batch_id    = $r->{import_batch_id};
>-        $error       = $r->{error};
>-        $bib         = $r->{biblionumber};
>-        $overlay     = $r->{match_status};
>-        $url         = $r->{url};
>-    }
>-    else {
>-        $koha_status = "error";
>-        $self->log("Response format error:\n$resp->content");
>-        return $self->error_response("Invalid response");
>-    }
>+        my ( $koha_status, $bib, $overlay, $batch_id, $error, $url );
>+        if ( my $r = eval { XMLin( $resp->content ) } ) {
>+            $koha_status = $r->{status};
>+            $batch_id    = $r->{import_batch_id};
>+            $error       = $r->{error};
>+            $bib         = $r->{biblionumber};
>+            $overlay     = $r->{match_status};
>+            $url         = $r->{url};
>+        } else {
>+            $koha_status = "error";
>+            $self->log("Response format error:\n$resp->content");
>+            return $self->error_response("Invalid response");
>+        }
> 
>-    if ($koha_status eq "ok") {
>-        my $response_string = sprintf( "Success.  Batch number %s - biblio record number %s",
>-                                        $batch_id,$bib);
>-        $response_string .= $overlay eq 'no_match' ? ' added to Koha.' : ' overlaid by import.';
>-        $response_string .= "\n\n$url";
>+        if ( $koha_status eq "ok" ) {
>+            my $response_string = sprintf(
>+                "Success.  Batch number %s - biblio record number %s",
>+                $batch_id, $bib
>+            );
>+            $response_string .= $overlay eq 'no_match' ? ' added to Koha.' : ' overlaid by import.';
>+            $response_string .= "\n\n$url";
> 
>-        return $self->response( $response_string );
>-    }
>-
>-    return $self->error_response( sprintf( "%s.  Please contact administrator.", $error ) );
>-}
>+            return $self->response($response_string);
>+        }
> 
>-sub error_response {
>-    my $self = shift;
>-    $self->response(@_);
>-}
>+        return $self->error_response( sprintf( "%s.  Please contact administrator.", $error ) );
>+    }
> 
>-sub response {
>-    my $self = shift;
>-    $self->log("Response: $_[0]");
>-    printf $_[0] . "\0";
>-}
>+    sub error_response {
>+        my $self = shift;
>+        $self->response(@_);
>+    }
> 
>+    sub response {
>+        my $self = shift;
>+        $self->log("Response: $_[0]");
>+        printf $_[0] . "\0";
>+    }
> 
>-} # package
>+}    # package
>-- 
>2.46.0

Actions: View | Diff | Splinter Review

Attachments on bug 37543: 169926 | 169958 | 170177 | 170178 | 170179 | 170180 | 170339 | 170340