Attachment #8678 for bug #7613

View | Details | Raw Unified | Return to bug 7613
Collapse All | Expand All




    
    my $dbh = C4::Context->dbh;
    
    my $batch_id = GetZ3950BatchId($filename);
    if ($batch_type eq 'z3950') {
        $batch_id = GetZ3950BatchId($filename);
    } else {
        # create a new one
        $batch_id = AddImportBatch('create_new', 'staging', 'batch', $filename, '');
    }
    my $searchisbn = $dbh->prepare("select biblioitemnumber from biblioitems where isbn=?");
    my $searchissn = $dbh->prepare("select biblioitemnumber from biblioitems where issn=?");
    # FIXME -- not sure that this kind of checking is actually needed




	@ISA    = qw(Exporter);
	@EXPORT = qw(
    GetZ3950BatchId
    GetWebserviceBatchId
    GetImportRecordMarc
    GetImportRecordMarcXML
    AddImportBatch
    GetImportBatch
    AddBiblioToBatch
    AddItemsToImportBiblio
    ModBiblioInBatch

    BatchStageMarcRecords

    CleanBatch

    GetAllImportBatches
    GetStagedWebserviceBatches
    GetImportBatchRangeDesc
    GetNumberOfNonZ3950ImportBatches
    GetImportBibliosRange

    if (defined $rowref) {
        return $rowref->[0];
    } else {
        my $batch_id = AddImportBatch( {
                overlay_action => 'create_new',
                import_status => 'staged',
                batch_type => 'z3950',
                file_name => $z3950server,
            } );
        return $batch_id;
    }
    
}

=head2 GetWebserviceBatchId

  my $batchid = GetWebserviceBatchId();

Retrieves the ID of the import batch for webservice.
If necessary, creates the import batch.

=cut

my $WEBSERVICE_BASE_QRY = <<EOQ;
SELECT import_batch_id FROM import_batches
WHERE  batch_type = 'webservice'
AND    import_status = 'staged'
EOQ
sub GetWebserviceBatchId {
    my ($params) = @_;

    my $dbh = C4::Context->dbh;
    my $sql = $WEBSERVICE_BASE_QRY;
    my @args;
    foreach my $field (qw(matcher_id overlay_action nomatch_action item_action)) {
        if (my $val = $params->{$field}) {
            $sql .= " AND $field = ?";
            push @args, $val;
        }
    }
    my $id = $dbh->selectrow_array($sql, undef, @args);
    return $id if $id;

    $params->{batch_type} = 'webservice';
    $params->{import_status} = 'staged';
    return AddImportBatch($params);
}

=head2 GetImportRecordMarc

  my ($marcblob, $encoding) = GetImportRecordMarc($import_record_id);


}

=head2 GetImportRecordMarcXML

  my $marcxml = GetImportRecordMarcXML($import_record_id);
                                $file_name, $comments);

=cut

sub GetImportRecordMarcXML {
    my ($import_record_id) = @_;

    my $dbh = C4::Context->dbh;
    my $sth = $dbh->prepare("SELECT marcxml FROM import_records WHERE import_record_id = ?");
    $sth->execute($import_record_id);
    my ($marcxml) = $sth->fetchrow();
    $sth->execute($overlay_action, $import_status, $type, $file_name, $comments);
    my $batch_id = $dbh->{'mysql_insertid'};
    $sth->finish();
    return $marcxml;

}

=head2 AddImportBatch

  my $batch_id = AddImportBatch($params_hash);

=cut

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

    my (@fields, @vals);
    foreach (qw( matcher_id template_id branchcode
                 overlay_action nomatch_action item_action
                 import_status batch_type file_name comments )) {
        if (exists $params->{$_}) {
            push @fields, $_;
            push @vals, $params->{$_};
        }
    }
    my $dbh = C4::Context->dbh;
    $dbh->do("INSERT INTO import_batches (".join( ',', @fields).")
                                  VALUES (".join( ',', map '?', @fields).")",
             undef,
             @vals);
    return $dbh->{'mysql_insertid'};
}

=head2 GetImportBatch 

        $progress_interval = 0 unless 'CODE' eq ref $progress_callback;
    } 
    
    my $batch_id = AddImportBatch( {
            overlay_action => 'create_new',
            import_status => 'staging',
            batch_type => 'batch',
            file_name => $file_name,
            comments => $comments,
        } );
    if ($parse_items) {
        SetImportBatchItemAction($batch_id, 'always_add');
    } else {

sub  GetAllImportBatches {
    my $dbh = C4::Context->dbh;
    my $sth = $dbh->prepare_cached("SELECT * FROM import_batches
                                    WHERE batch_type IN ('batch', 'webservice')
                                    ORDER BY import_batch_id ASC");

    my $results = [];

    return $results;
}

=head2 GetStagedWebserviceBatches

  my $batch_ids = GetStagedWebserviceBatches();

Returns a references to an array of batch id's
of batch_type 'webservice' that are not imported

=cut

my $PENDING_WEBSERVICE_BATCHES_QRY = <<EOQ;
SELECT import_batch_id FROM import_batches
WHERE batch_type = 'webservice'
AND import_status = 'staged'
EOQ
sub  GetStagedWebserviceBatches {
    my $dbh = C4::Context->dbh;
    return $dbh->selectcol_arrayref($PENDING_WEBSERVICE_BATCHES_QRY);
}

=head2 GetImportBatchRangeDesc

  my $results = GetImportBatchRangeDesc($offset, $results_per_group);


    my $dbh = C4::Context->dbh;
    my $query = "SELECT * FROM import_batches
                                    WHERE batch_type IN ('batch', 'webservice')
                                    ORDER BY import_batch_id DESC";
    my @params;
    if ($results_per_group){


sub GetNumberOfNonZ3950ImportBatches {
    my $dbh = C4::Context->dbh;
    my $sth = $dbh->prepare("SELECT COUNT(*) FROM import_batches WHERE batch_type != 'z3950'");
    $sth->execute();
    my ($count) = $sth->fetchrow_array();
    $sth->finish();

    my ($batch_id) = @_;

    my $dbh = C4::Context->dbh;
    my $sth = $dbh->prepare_cached("UPDATE import_batches SET
                                        num_biblios = (
                                            SELECT COUNT(*)
                                            FROM import_records
                                            WHERE import_batch_id = import_batches.import_batch_id
                                            AND record_type = 'biblio'),
                                        num_items = (
                                            SELECT COUNT(*)
                                            FROM import_records
                                            JOIN import_items USING (import_record_id)
                                            WHERE import_batch_id = import_batches.import_batch_id
                                            AND record_type = 'biblio')
                                    JOIN import_items USING (import_record_id)
                                    WHERE import_batch_id = import_batches.import_batch_id
                                    AND record_type = 'biblio')
                                    WHERE import_batch_id = ?");
    $sth->bind_param(1, $batch_id);
    $sth->execute();
    $sth->finish();

}

sub _get_commit_action {




    return @results;
}

=head2 GetMatcherId

  my $matcher_id = C4::Matcher::GetMatcherId($code);

Returns the matcher_id of a code.

=cut

sub GetMatcherId {
    my ($code) = @_;
    my $dbh = C4::Context->dbh;
    
    my $matcher_id = $dbh->selectrow_array("SELECT matcher_id FROM marc_matchers WHERE code = ?", undef, $code);
    return $matcher_id;
}

=head1 METHODS

=head2 new

Lines 858-864 CREATE TABLE `import_batches` ( Link Here

(-)a/installer/data/mysql/kohastructure.sql (-1 / +1 lines)
858	`nomatch_action` enum('create_new', 'ignore') NOT NULL default 'create_new',	858	`nomatch_action` enum('create_new', 'ignore') NOT NULL default 'create_new',
859	`item_action` enum('always_add', 'add_only_for_matches', 'add_only_for_new', 'ignore') NOT NULL default 'always_add',	859	`item_action` enum('always_add', 'add_only_for_matches', 'add_only_for_new', 'ignore') NOT NULL default 'always_add',
860	`import_status` enum('staging', 'staged', 'importing', 'imported', 'reverting', 'reverted', 'cleaned') NOT NULL default 'staging',	860	`import_status` enum('staging', 'staged', 'importing', 'imported', 'reverting', 'reverted', 'cleaned') NOT NULL default 'staging',
861	`batch_type` enum('batch', 'z3950') NOT NULL default 'batch',	861	`batch_type` enum('batch', 'z3950', 'webservice') NOT NULL default 'batch',
862	`file_name` varchar(100),	862	`file_name` varchar(100),
863	`comments` mediumtext,	863	`comments` mediumtext,
864	PRIMARY KEY (`import_batch_id`),	864	PRIMARY KEY (`import_batch_id`),




    SetVersion($DBversion);
}




$DBversion = "3.07.00.XXX";
if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
    $dbh->do("ALTER TABLE import_batches MODIFY COLUMN batch_type ENUM('batch','z3950','webservice') NOT NULL default 'batch'");
    print "Upgrade to $DBversion done (Add 'webservice' to batch_type enum)\n";
    SetVersion ($DBversion);
}

=head1 FUNCTIONS

=head2 DropAllForeignKeys($table)




#!/usr/bin/perl -w

# Copyright 2012 CatalystIT
#
# This file is part of Koha.
#
# 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 2 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use strict;
use warnings;

use Getopt::Long;

my ($help, $config, $daemon);

GetOptions(
    'config|c=s'    => \$config,
    'daemon|d'      => \$daemon,
    'help|?'        => \$help,
);

if($help || !$config){
    print <<EOF
$0 --config=my.conf
Parameters :
  --daemon | -d  - go to background; prints pid to stdout
  --config | -c  - config file
  --help   | -?  - this message

Config file format:
  Lines of the form:
  name: value

  # comments are supported
  No quotes

  Parameter Names:
  host     - ip address or hostname to bind to, defaults all available
  port     - port to bind to, mandatory
  log      - log file path, stderr if omitted
  debug    - dumps requests to the log file, passwords inclusive
  koha     - koha intranet base url, eg http://librarian.koha
  user     - koha user, authentication
  password - koha user password, authentication
  match          - marc_matchers.code: ISBN or ISSN
  overlay_action - import_batches.overlay_action: replace, create_new or ignore
  nomatch_action - import_batches.nomatch_action: create_new or ignore
  item_action    - import_batches.item_action:    always_add,
                      add_only_for_matches, add_only_for_new or ignore
  import_mode    - stage or direct
  framework      - to be used if import_mode is direct

  All process related parameters (all but ip and port) have default values as
  per Koha import process.
EOF
;
    exit;
}

my $server = ImportProxyServer->new($config);

if ($daemon) {
    print $server->background;
} else {
    $server->run;
}

exit;

{
package ImportProxyServer;
       
use Carp;
use IO::Socket::INET;
# use IO::Socket::IP;
use IO::Select;
use POSIX;
use HTTP::Status qw(:constants);

use LWP::UserAgent;
use XML::Simple;

use constant CLIENT_READ_TIMEOUT     => 5;
use constant CLIENT_READ_BUFFER_SIZE => 4 * 1024;
use constant AUTH_URI       => "/cgi-bin/koha/mainpage.pl";
use constant IMPORT_SVC_URI => "/cgi-bin/koha/svc/import_bib";

sub new {
    my $class = shift;
    my $config_file = shift or croak "No config file";

    my $self = {time_to_die => 0, config_file => $config_file };
    bless $self, $class;

    $self->parse_config;
    return $self;
}

sub parse_config {
    my $self = shift;

    my $config_file = $self->{config_file};

    open CONF, $config_file or die "Cannot open config file $config: $!";

    my %param;
    my $line = 0;
    while (<CONF>) {
        $line++;
        chomp;
        s/\s*#.*//o; # remove comments
        s/^\s+//o;   # trim leading spaces
        s/\s+$//o;   # trim trailing spaces
        next unless $_;
        
        my ($p, $v) = m/(\S+?):\s*(.*)/o;
        die "Invalid config line $line: $_" unless defined $v;
        $param{$p} = $v;
    }

    $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";

    $self->{host} = delete( $param{host} );
    $self->{port} = delete( $param{port} )
      or die "Port not specified";

    $self->{debug} = delete( $param{debug} );

    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;

    $self->{params} = \%param;
}

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", @_;
}

sub background {
    my $self = shift;

    my $pid = fork;
    return ($pid) if $pid; # parent

    die "Couldn't fork: $!" unless defined($pid);

    POSIX::setsid() or die "Can't start a new session: $!";

    $SIG{INT} = $SIG{TERM} = $SIG{HUP} = sub { $self->{time_to_die} = 1 };
    # trap or ignore $SIG{PIPE}
    $SIG{USR1} = sub { $self->parse_config };

    $self->run;
}

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};
    }

    close($server);
}

sub _ua {
    my $ua = LWP::UserAgent->new;
    $ua->timeout(10);
    $ua->cookie_jar({});
    return $ua;
}

sub read_request {
    my ( $self, $io ) = @_;

    my ($in, @in, $timeout);
    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, $1;
                last;
            }
            push @in, $in;
        }
        else {
            $timeout = 1;
            last;
        }
    }

    $in = join '', @in;

    my ($xml, $user, $password, $local_user);
    my $data = $in; # copy for diagmostic purposes
    while ( my $first = substr( $data, 0, 1 ) ) {
        $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;
        };
        $first eq '<' && do {
            $xml = $data;
            last;
        };

        last; # unexpected input
    }

    my @details;
    push @details, "Timeout" if $timeout;
    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;
    unless ($xml) {
        $self->log("Invalid request", $in, @details);
        return;
    }

    $self->log("Request", @details);
    $self->log($in) if $self->{debug};
    return ($xml, $user, $password);
}

sub _trim_identifier {
    my ($a, $len) = unpack "cc", substr( $_[0], 0, 2 );

    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");

    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 $resp = $ua->post( $base_url.IMPORT_SVC_URI, $self->{params}, 'Content-Type' => 'text/plain', Content => $data );
    my $status = $resp->code;
    if ($status == HTTP_UNAUTHORIZED || $status == HTTP_FORBIDDEN) {
        my $user = $self->{user};
        my $password = $self->{password};
        $resp = $ua->post( $base_url.AUTH_URI, { userid => $user, password => $password } );
        $resp = $ua->post( $base_url.IMPORT_SVC_URI, $self->{params}, 'Content-Type' => 'text/plain', Content => $data )
          if $resp->is_success;
    }
    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, $batch_id, $error);
    if ( my $r = eval { XMLin($resp->content) } ) {
        $koha_status = $r->{status};
        $batch_id    = $r->{import_batch_id};
        $error       = $r->{error};
    }
    else {
        $koha_status = "error";
        $self->log("Response format error:\n$resp->content");
        return $self->error_response("Invalid response");
    }

    if ($koha_status eq "ok") {
        return $self->response( sprintf( "Success. Import batch id: %s", $batch_id ) );
    }

    return $self->error_response( sprintf( "%s.  Please contact administrator.", $error ) );
}

sub error_response {
    my $self = shift;
    $self->response(@_);
}

sub response {
    my $self = shift;
    $self->log("Response: $_[0]");
    printf $_[0] . "\0";
}


} # package





#!/usr/bin/perl -w

# Copyright 2012 CatalystIT
#
# This file is part of Koha.
#
# 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 2 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use strict;
use warnings;
use utf8;

BEGIN {

    # find Koha's Perl modules
    # test carefully before changing this
    use FindBin;
    eval { require "$FindBin::Bin/../kohalib.pl" };
}

use Getopt::Long;
use Pod::Usage;
use C4::ImportBatch;

my ($help, $framework);

GetOptions(
    'help|?'         => \$help,
    'framework=s'    => \$framework,
);

if($help){
    print <<EOF
$0 --framework=myframework
Parameters :
--help|? This message
--framework default ""
EOF
;
    exit;
}

my $batch_ids = GetStagedWebserviceBatches() or exit;

$framework ||= '';
BatchCommitBibRecords($_, $framework) foreach @$batch_ids;




#!/usr/bin/perl

# Copyright 2012 CatalystIT Ltd
#
# This file is part of Koha.
#
# 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 2 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
#

use strict;
use warnings;

use CGI;
use C4::Auth qw/check_api_auth/;
use C4::Context;
use C4::ImportBatch;
use C4::Matcher;
use XML::Simple;
# use Carp::Always;

my $query = new CGI;
binmode STDOUT, ':encoding(UTF-8)';

my ($status, $cookie, $sessionID) = check_api_auth($query, { editcatalogue => 'edit_catalogue'} );
unless ($status eq "ok") {
    print $query->header(-type => 'text/xml', -status => '403 Forbidden');
    print XMLout({ auth_status => $status }, NoAttr => 1, RootName => 'response', XMLDecl => 1);
    exit 0;
}

my $xml;
if ($query->request_method eq "POST") {
    $xml = $query->param('POSTDATA');
}
if ($xml) {
    my %params = map { $_ => $query->url_param($_) } $query->url_param;
    my $result = import_bib($xml, \%params );
    print $query->header(-type => 'text/xml');
    print XMLout($result, NoAttr => 1, RootName => 'response', XMLDecl => 1); 
} else {
    print $query->header(-type => 'text/xml', -status => '400 Bad Request');
}

exit 0;

sub import_bib {
    my ($inxml, $params) = @_;

    my $result = {};

    my $import_mode = delete $params->{import_mode} || '';
    my $framework   = delete $params->{framework}   || '';

    if (my $matcher_code = delete $params->{matcher}) {
        $params->{matcher_id} = C4::Matcher::GetMatcherId($matcher_code);
    }
    
    my $batch_id = GetWebserviceBatchId($params);
    unless ($batch_id) {
        $result->{'status'} = "failed";
        $result->{'error'} = "Batch create error";
        return $result;
    }

    my $marcflavour = C4::Context->preference('marcflavour') || 'MARC21';
    my $marc_record = eval {MARC::Record::new_from_xml( $inxml, "utf8", $marcflavour)};
    if ($@) {
        $result->{'status'} = "failed";
        $result->{'error'} = $@;
        return $result;
    }

    my $import_record_id = AddBiblioToBatch($batch_id, 0, $marc_record, "utf8", int(rand(99999)));
    my @import_items_ids = AddItemsToImportBiblio($batch_id, $import_record_id, $marc_record, 'UPDATE COUNTS');
    my $marcxml = GetImportRecordMarcXML($import_record_id);
    unless ($marcxml) {
        $result->{'status'} = "failed";
        $result->{'error'} = "database write error";
        return $result;
    }
    $marcxml =~ s/<\?xml.*?\?>//i;

    # XXX we are ignoring the result of this;
    BatchCommitBibRecords($batch_id, $framework) if lc($import_mode) eq 'direct';

    $result->{'status'} = "ok";
    $result->{'import_batch_id'} =  $batch_id;
    $result->{'marcxml'} =  $marcxml;
    return $result;
}

Lines 118-128 sub add_import_batch { Link Here

(-)a/t/db_dependent/lib/KohaTest/ImportBatch.pm (-5 / +1 lines)
118	file_name => 'foo',	118	file_name => 'foo',
119	comments => 'inserted during automated testing',	119	comments => 'inserted during automated testing',
120	};	120	};
121	my $batch_id = AddImportBatch( $test_batch->{'overlay_action'},	121	my $batch_id = AddImportBatch( $test_batch );
122	$test_batch->{'import_status'},
123	$test_batch->{'batch_type'},
124	$test_batch->{'file_name'},
125	$test_batch->{'comments'}, );
126	return $batch_id;	122	return $batch_id;
127	}	123	}
128		124




package KohaTest::ImportBatch::AddImportBatch;
use base qw( KohaTest::ImportBatch );

use strict;
use warnings;

use Test::More;

use C4::ImportBatch;
use C4::Matcher;
use C4::Biblio;


=head3 add_one

=cut

sub add_one : Test( 1 ) {
    my $self = shift;

    my $batch_id = AddImportBatch(
        'create_new',                           #overlay_action
        'staging',                              # import_status
        'batch',                                # batc_type
        'foo',                                  # file_name
        'inserted during automated testing',    # comments
    );
    ok( $batch_id, "successfully inserted batch: $batch_id" );
}

1;




        file_name      => 'foo',
        comments       => 'inserted during automated testing',
    };
    my $batch_id = AddImportBatch($batch);
      $batch->{'overlay_action'},
      $batch->{'import_status'},
      $batch->{'batch_type'},
      $batch->{'file_name'},
      $batch->{'comments'},
    );
    ok( $batch_id, "successfully inserted batch: $batch_id" );

    my $retrieved = GetImportBatch( $batch_id );

Lines 218-224 sub import_batches_list { Link Here

(-)a/tools/manage-marc-import.pl (-2 / +1 lines)
218	num_items => $batch->{'num_items'},	218	num_items => $batch->{'num_items'},
219	upload_timestamp => $batch->{'upload_timestamp'},	219	upload_timestamp => $batch->{'upload_timestamp'},
220	import_status => $batch->{'import_status'},	220	import_status => $batch->{'import_status'},
221	file_name => $batch->{'file_name'},	221	file_name => $batch->{'file_name'} \|\| "($batch->{'batch_type'})",
222	comments => $batch->{'comments'},	222	comments => $batch->{'comments'},
223	can_clean => ($batch->{'import_status'} ne 'cleaned') ? 1 : 0,	223	can_clean => ($batch->{'import_status'} ne 'cleaned') ? 1 : 0,
224	};	224	};
225	-

Return to bug 7613

Lines 5095-5100 if (C4::Context->preference("Version") < TransformToNum($DBversion)) { Link Here

(-)a/installer/data/mysql/updatedatabase.pl (+10 lines)
5095	SetVersion($DBversion);	5095	SetVersion($DBversion);
5096	}	5096	}
5097		5097
		5098
		5099
		5100
		5101	$DBversion = "3.07.00.XXX";
		5102	if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
		5103	$dbh->do("ALTER TABLE import_batches MODIFY COLUMN batch_type ENUM('batch','z3950','webservice') NOT NULL default 'batch'");
		5104	print "Upgrade to $DBversion done (Add 'webservice' to batch_type enum)\n";
		5105	SetVersion ($DBversion);
		5106	}
		5107
5098	=head1 FUNCTIONS	5108	=head1 FUNCTIONS
5099		5109
5100	=head2 DropAllForeignKeys($table)	5110	=head2 DropAllForeignKeys($table)

Lines 76-88 sub ImportBreeding { Link Here

(-)a/C4/Breeding.pm (-7 / +1 lines)
76		76
77	my $dbh = C4::Context->dbh;	77	my $dbh = C4::Context->dbh;
78		78
79	my $batch_id = 0;	79	my $batch_id = GetZ3950BatchId($filename);
80	if ($batch_type eq 'z3950') {
81	$batch_id = GetZ3950BatchId($filename);
82	} else {
83	# create a new one
84	$batch_id = AddImportBatch('create_new', 'staging', 'batch', $filename, '');
85	}
86	my $searchisbn = $dbh->prepare("select biblioitemnumber from biblioitems where isbn=?");	80	my $searchisbn = $dbh->prepare("select biblioitemnumber from biblioitems where isbn=?");
87	my $searchissn = $dbh->prepare("select biblioitemnumber from biblioitems where issn=?");	81	my $searchissn = $dbh->prepare("select biblioitemnumber from biblioitems where issn=?");
88	# FIXME -- not sure that this kind of checking is actually needed	82	# FIXME -- not sure that this kind of checking is actually needed

Lines 35-44 BEGIN { Link Here

(-)a/C4/ImportBatch.pm (-32 / +118 lines)
35	@ISA = qw(Exporter);	35	@ISA = qw(Exporter);
36	@EXPORT = qw(	36	@EXPORT = qw(
37	GetZ3950BatchId	37	GetZ3950BatchId
		38	GetWebserviceBatchId
38	GetImportRecordMarc	39	GetImportRecordMarc
		40	GetImportRecordMarcXML
39	AddImportBatch	41	AddImportBatch
40	GetImportBatch	42	GetImportBatch
41	AddBiblioToBatch	43	AddBiblioToBatch
		44	AddItemsToImportBiblio
42	ModBiblioInBatch	45	ModBiblioInBatch
43		46
44	BatchStageMarcRecords	47	BatchStageMarcRecords
Lines 48-53 BEGIN { Link Here
48	CleanBatch	51	CleanBatch
49		52
50	GetAllImportBatches	53	GetAllImportBatches
		54	GetStagedWebserviceBatches
51	GetImportBatchRangeDesc	55	GetImportBatchRangeDesc
52	GetNumberOfNonZ3950ImportBatches	56	GetNumberOfNonZ3950ImportBatches
53	GetImportBibliosRange	57	GetImportBibliosRange
Lines 105-116 sub GetZ3950BatchId { Link Here
105	if (defined $rowref) {	109	if (defined $rowref) {
106	return $rowref->[0];	110	return $rowref->[0];
107	} else {	111	} else {
108	my $batch_id = AddImportBatch('create_new', 'staged', 'z3950', $z3950server, '');	112	my $batch_id = AddImportBatch( {
		113	overlay_action => 'create_new',
		114	import_status => 'staged',
		115	batch_type => 'z3950',
		116	file_name => $z3950server,
		117	} );
109	return $batch_id;	118	return $batch_id;
110	}	119	}
111		120
112	}	121	}
113		122
		123	=head2 GetWebserviceBatchId
		124
		125	my $batchid = GetWebserviceBatchId();
		126
		127	Retrieves the ID of the import batch for webservice.
		128	If necessary, creates the import batch.
		129
		130	=cut
		131
		132	my $WEBSERVICE_BASE_QRY = <<EOQ;
		133	SELECT import_batch_id FROM import_batches
		134	WHERE batch_type = 'webservice'
		135	AND import_status = 'staged'
		136	EOQ
		137	sub GetWebserviceBatchId {
		138	my ($params) = @_;
		139
		140	my $dbh = C4::Context->dbh;
		141	my $sql = $WEBSERVICE_BASE_QRY;
		142	my @args;
		143	foreach my $field (qw(matcher_id overlay_action nomatch_action item_action)) {
		144	if (my $val = $params->{$field}) {
		145	$sql .= " AND $field = ?";
		146	push @args, $val;
		147	}
		148	}
		149	my $id = $dbh->selectrow_array($sql, undef, @args);
		150	return $id if $id;
		151
		152	$params->{batch_type} = 'webservice';
		153	$params->{import_status} = 'staged';
		154	return AddImportBatch($params);
		155	}
		156
114	=head2 GetImportRecordMarc	157	=head2 GetImportRecordMarc
115		158
116	my ($marcblob, $encoding) = GetImportRecordMarc($import_record_id);	159	my ($marcblob, $encoding) = GetImportRecordMarc($import_record_id);
Lines 129-154 sub GetImportRecordMarc { Link Here
129		172
130	}	173	}
131		174
132	=head2 AddImportBatch	175	=head2 GetImportRecordMarcXML
133		176
134	my $batch_id = AddImportBatch($overlay_action, $import_status, $type,	177	my $marcxml = GetImportRecordMarcXML($import_record_id);
135	$file_name, $comments);
136		178
137	=cut	179	=cut
138		180
139	sub AddImportBatch {	181	sub GetImportRecordMarcXML {
140	my ($overlay_action, $import_status, $type, $file_name, $comments) = @_;	182	my ($import_record_id) = @_;
141		183
142	my $dbh = C4::Context->dbh;	184	my $dbh = C4::Context->dbh;
143	my $sth = $dbh->prepare("INSERT INTO import_batches (overlay_action, import_status, batch_type,	185	my $sth = $dbh->prepare("SELECT marcxml FROM import_records WHERE import_record_id = ?");
144	file_name, comments)	186	$sth->execute($import_record_id);
145	VALUES (?, ?, ?, ?, ?)");	187	my ($marcxml) = $sth->fetchrow();
146	$sth->execute($overlay_action, $import_status, $type, $file_name, $comments);
147	my $batch_id = $dbh->{'mysql_insertid'};
148	$sth->finish();	188	$sth->finish();
		189	return $marcxml;
149		190
150	return $batch_id;	191	}
		192
		193	=head2 AddImportBatch
151		194
		195	my $batch_id = AddImportBatch($params_hash);
		196
		197	=cut
		198
		199	sub AddImportBatch {
		200	my ($params) = @_;
		201
		202	my (@fields, @vals);
		203	foreach (qw( matcher_id template_id branchcode
		204	overlay_action nomatch_action item_action
		205	import_status batch_type file_name comments )) {
		206	if (exists $params->{$_}) {
		207	push @fields, $_;
		208	push @vals, $params->{$_};
		209	}
		210	}
		211	my $dbh = C4::Context->dbh;
		212	$dbh->do("INSERT INTO import_batches (".join( ',', @fields).")
		213	VALUES (".join( ',', map '?', @fields).")",
		214	undef,
		215	@vals);
		216	return $dbh->{'mysql_insertid'};
152	}	217	}
153		218
154	=head2 GetImportBatch	219	=head2 GetImportBatch
Lines 237-243 sub BatchStageMarcRecords { Link Here
237	$progress_interval = 0 unless 'CODE' eq ref $progress_callback;	302	$progress_interval = 0 unless 'CODE' eq ref $progress_callback;
238	}	303	}
239		304
240	my $batch_id = AddImportBatch('create_new', 'staging', 'batch', $file_name, $comments);	305	my $batch_id = AddImportBatch( {
		306	overlay_action => 'create_new',
		307	import_status => 'staging',
		308	batch_type => 'batch',
		309	file_name => $file_name,
		310	comments => $comments,
		311	} );
241	if ($parse_items) {	312	if ($parse_items) {
242	SetImportBatchItemAction($batch_id, 'always_add');	313	SetImportBatchItemAction($batch_id, 'always_add');
243	} else {	314	} else {
Lines 688-694 ascending order by import_batch_id. Link Here
688	sub GetAllImportBatches {	759	sub GetAllImportBatches {
689	my $dbh = C4::Context->dbh;	760	my $dbh = C4::Context->dbh;
690	my $sth = $dbh->prepare_cached("SELECT * FROM import_batches	761	my $sth = $dbh->prepare_cached("SELECT * FROM import_batches
691	WHERE batch_type = 'batch'	762	WHERE batch_type IN ('batch', 'webservice')
692	ORDER BY import_batch_id ASC");	763	ORDER BY import_batch_id ASC");
693		764
694	my $results = [];	765	my $results = [];
Lines 700-705 sub GetAllImportBatches { Link Here
700	return $results;	771	return $results;
701	}	772	}
702		773
		774	=head2 GetStagedWebserviceBatches
		775
		776	my $batch_ids = GetStagedWebserviceBatches();
		777
		778	Returns a references to an array of batch id's
		779	of batch_type 'webservice' that are not imported
		780
		781	=cut
		782
		783	my $PENDING_WEBSERVICE_BATCHES_QRY = <<EOQ;
		784	SELECT import_batch_id FROM import_batches
		785	WHERE batch_type = 'webservice'
		786	AND import_status = 'staged'
		787	EOQ
		788	sub GetStagedWebserviceBatches {
		789	my $dbh = C4::Context->dbh;
		790	return $dbh->selectcol_arrayref($PENDING_WEBSERVICE_BATCHES_QRY);
		791	}
		792
703	=head2 GetImportBatchRangeDesc	793	=head2 GetImportBatchRangeDesc
704		794
705	my $results = GetImportBatchRangeDesc($offset, $results_per_group);	795	my $results = GetImportBatchRangeDesc($offset, $results_per_group);
Lines 715-721 sub GetImportBatchRangeDesc { Link Here
715		805
716	my $dbh = C4::Context->dbh;	806	my $dbh = C4::Context->dbh;
717	my $query = "SELECT * FROM import_batches	807	my $query = "SELECT * FROM import_batches
718	WHERE batch_type = 'batch'	808	WHERE batch_type IN ('batch', 'webservice')
719	ORDER BY import_batch_id DESC";	809	ORDER BY import_batch_id DESC";
720	my @params;	810	my @params;
721	if ($results_per_group){	811	if ($results_per_group){
Lines 759-765 sub GetItemNumbersFromImportBatch { Link Here
759		849
760	sub GetNumberOfNonZ3950ImportBatches {	850	sub GetNumberOfNonZ3950ImportBatches {
761	my $dbh = C4::Context->dbh;	851	my $dbh = C4::Context->dbh;
762	my $sth = $dbh->prepare("SELECT COUNT(*) FROM import_batches WHERE batch_type='batch'");	852	my $sth = $dbh->prepare("SELECT COUNT(*) FROM import_batches WHERE batch_type != 'z3950'");
763	$sth->execute();	853	$sth->execute();
764	my ($count) = $sth->fetchrow_array();	854	my ($count) = $sth->fetchrow_array();
765	$sth->finish();	855	$sth->finish();
Lines 1196-1221 sub _update_batch_record_counts { Link Here
1196	my ($batch_id) = @_;	1286	my ($batch_id) = @_;
1197		1287
1198	my $dbh = C4::Context->dbh;	1288	my $dbh = C4::Context->dbh;
1199	my $sth = $dbh->prepare_cached("UPDATE import_batches SET num_biblios = (	1289	my $sth = $dbh->prepare_cached("UPDATE import_batches SET
1200	SELECT COUNT(*)	1290	num_biblios = (
1201	FROM import_records	1291	SELECT COUNT(*)
1202	WHERE import_batch_id = import_batches.import_batch_id	1292	FROM import_records
1203	AND record_type = 'biblio')	1293	WHERE import_batch_id = import_batches.import_batch_id
1204	WHERE import_batch_id = ?");	1294	AND record_type = 'biblio'),
1205	$sth->bind_param(1, $batch_id);	1295	num_items = (
1206	$sth->execute();	1296	SELECT COUNT(*)
1207	$sth->finish();	1297	FROM import_records
1208	$sth = $dbh->prepare_cached("UPDATE import_batches SET num_items = (	1298	JOIN import_items USING (import_record_id)
1209	SELECT COUNT(*)	1299	WHERE import_batch_id = import_batches.import_batch_id
1210	FROM import_records	1300	AND record_type = 'biblio')
1211	JOIN import_items USING (import_record_id)
1212	WHERE import_batch_id = import_batches.import_batch_id
1213	AND record_type = 'biblio')
1214	WHERE import_batch_id = ?");	1301	WHERE import_batch_id = ?");
1215	$sth->bind_param(1, $batch_id);	1302	$sth->bind_param(1, $batch_id);
1216	$sth->execute();	1303	$sth->execute();
1217	$sth->finish();	1304	$sth->finish();
1218
1219	}	1305	}
1220		1306
1221	sub _get_commit_action {	1307	sub _get_commit_action {

Lines 95-100 sub GetMatcherList { Link Here

(-)a/C4/Matcher.pm (+16 lines)
95	return @results;	95	return @results;
96	}	96	}
97		97
		98	=head2 GetMatcherId
		99
		100	my $matcher_id = C4::Matcher::GetMatcherId($code);
		101
		102	Returns the matcher_id of a code.
		103
		104	=cut
		105
		106	sub GetMatcherId {
		107	my ($code) = @_;
		108	my $dbh = C4::Context->dbh;
		109
		110	my $matcher_id = $dbh->selectrow_array("SELECT matcher_id FROM marc_matchers WHERE code = ?", undef, $code);
		111	return $matcher_id;
		112	}
		113
98	=head1 METHODS	114	=head1 METHODS
99		115
100	=head2 new	116	=head2 new

Line 0 Link Here

(-)a/misc/bin/connexion_import_daemon.pl (+358 lines)
		1	#!/usr/bin/perl -w
		2
		3	# Copyright 2012 CatalystIT
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha 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	# Koha 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 Koha; if not, write to the Free Software Foundation, Inc.,
		18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		19
		20	use strict;
		21	use warnings;
		22
		23	use Getopt::Long;
		24
		25	my ($help, $config, $daemon);
		26
		27	GetOptions(
		28	'config\|c=s' => \$config,
		29	'daemon\|d' => \$daemon,
		30	'help\|?' => \$help,
		31	);
		32
		33	if($help \|\| !$config){
		34	print <<EOF
		35	$0 --config=my.conf
		36	Parameters :
		37	--daemon \| -d - go to background; prints pid to stdout
		38	--config \| -c - config file
		39	--help \| -? - this message
		40
		41	Config file format:
		42	Lines of the form:
		43	name: value
		44
		45	# comments are supported
		46	No quotes
		47
		48	Parameter Names:
		49	host - ip address or hostname to bind to, defaults all available
		50	port - port to bind to, mandatory
		51	log - log file path, stderr if omitted
		52	debug - dumps requests to the log file, passwords inclusive
		53	koha - koha intranet base url, eg http://librarian.koha
		54	user - koha user, authentication
		55	password - koha user password, authentication
		56	match - marc_matchers.code: ISBN or ISSN
		57	overlay_action - import_batches.overlay_action: replace, create_new or ignore
		58	nomatch_action - import_batches.nomatch_action: create_new or ignore
		59	item_action - import_batches.item_action: always_add,
		60	add_only_for_matches, add_only_for_new or ignore
		61	import_mode - stage or direct
		62	framework - to be used if import_mode is direct
		63
		64	All process related parameters (all but ip and port) have default values as
65	per Koha import process.
66	EOF
67	;
68	exit;
69	}
70
71	my $server = ImportProxyServer->new($config);
72
73	if ($daemon) {
74	print $server->background;
75	} else {
76	$server->run;
77	}
78
79	exit;
80
81	{
82	package ImportProxyServer;
83
84	use Carp;
85	use IO::Socket::INET;
86	# use IO::Socket::IP;
87	use IO::Select;
88	use POSIX;
89	use HTTP::Status qw(:constants);
90
91	use LWP::UserAgent;
92	use XML::Simple;
93
94	use constant CLIENT_READ_TIMEOUT => 5;
95	use constant CLIENT_READ_BUFFER_SIZE => 4 * 1024;
96	use constant AUTH_URI => "/cgi-bin/koha/mainpage.pl";
97	use constant IMPORT_SVC_URI => "/cgi-bin/koha/svc/import_bib";
98
99	sub new {
100	my $class = shift;
101	my $config_file = shift or croak "No config file";
102
103	my $self = {time_to_die => 0, config_file => $config_file };
104	bless $self, $class;
105
106	$self->parse_config;
107	return $self;
108	}
109
110	sub parse_config {
111	my $self = shift;
112
113	my $config_file = $self->{config_file};
114
115	open CONF, $config_file or die "Cannot open config file $config: $!";
116
117	my %param;
118	my $line = 0;
119	while (<CONF>) {
120	$line++;
121	chomp;
122	s/\s#.//o; # remove comments
123	s/^\s+//o; # trim leading spaces
124	s/\s+$//o; # trim trailing spaces
125	next unless $_;
126
127	my ($p, $v) = m/(\S+?):\s(.)/o;
128	die "Invalid config line $line: $_" unless defined $v;
129	$param{$p} = $v;
130	}
131
132	$self->{koha} = delete( $param{koha} )
133	or die "No koha base url in config file";
134	$self->{user} = delete( $param{user} )
135	or die "No koha user in config file";
136	$self->{password} = delete( $param{password} )
137	or die "No koha user password in config file";
138
139	$self->{host} = delete( $param{host} );
140	$self->{port} = delete( $param{port} )
141	or die "Port not specified";
142
143	$self->{debug} = delete( $param{debug} );
144
145	my $log_fh;
146	close $self->{log_fh} if $self->{log_fh};
147	if (my $logfile = delete $param{log}) {
148	open $log_fh, ">>$logfile" or die "Cannot open $logfile for write: $!";
149	} else {
150	$log_fh = \*STDERR;
151	}
152	$self->{log_fh} = $log_fh;
153
154	$self->{params} = \%param;
155	}
156
157	sub log {
158	my $self = shift;
159	my $log_fh = $self->{log_fh}
160	or warn "No log fh",
161	return;
162	my $t = localtime;
163	print $log_fh map "$t: $_\n", @_;
164	}
165
166	sub background {
167	my $self = shift;
168
169	my $pid = fork;
170	return ($pid) if $pid; # parent
171
172	die "Couldn't fork: $!" unless defined($pid);
173
174	POSIX::setsid() or die "Can't start a new session: $!";
175
176	$SIG{INT} = $SIG{TERM} = $SIG{HUP} = sub { $self->{time_to_die} = 1 };
177	# trap or ignore $SIG{PIPE}
178	$SIG{USR1} = sub { $self->parse_config };
179
180	$self->run;
181	}
182
183	sub run {
184	my $self = shift;
185
186	my $server_port = $self->{port};
187	my $server_host = $self->{host};
188
189	my $server = IO::Socket::INET->new(
190	LocalHost => $server_host,
191	LocalPort => $server_port,
192	Type => SOCK_STREAM,
193	Proto => "tcp",
194	Listen => 12,
195	Blocking => 1,
196	ReuseAddr => 1,
197	) or die "Couldn't be a tcp server on port $server_port: $! $@";
198
199	$self->log("Started tcp listener on $server_host:$server_port");
200
201	$self->{ua} = _ua();
202
203	while ("FOREVER") {
204	my $client = $server->accept()
205	or die "Cannot accept: $!";
206	my $oldfh = select($client);
207	$self->handle_request($client);
208	select($oldfh);
209	last if $self->{time_to_die};
210	}
211
212	close($server);
213	}
214
215	sub _ua {
216	my $ua = LWP::UserAgent->new;
217	$ua->timeout(10);
218	$ua->cookie_jar({});
219	return $ua;
220	}
221
222	sub read_request {
223	my ( $self, $io ) = @_;
224
225	my ($in, @in, $timeout);
226	my $select = IO::Select->new($io) ;
227	while ( "FOREVER" ) {
228	if ( $select->can_read(CLIENT_READ_TIMEOUT) ){
229	$io->recv($in, CLIENT_READ_BUFFER_SIZE);
230	last unless $in;
231
232	# XXX ignore after NULL
233	if ( $in =~ m/^(.*)\000/so ) { # null received, EOT
234	push @in, $1;
235	last;
236	}
237	push @in, $in;
238	}
239	else {
240	$timeout = 1;
241	last;
242	}
243	}
244
245	$in = join '', @in;
246
247	my ($xml, $user, $password, $local_user);
248	my $data = $in; # copy for diagmostic purposes
249	while ( my $first = substr( $data, 0, 1 ) ) {
250	$first eq 'U' && do {
251	($user, $data) = _trim_identifier($data);
252	next;
253	};
254	$first eq 'A' && do {
255	($local_user, $data) = _trim_identifier($data);
256	next;
257	};
258	$first eq 'P' && do {
259	($password,, $data) = _trim_identifier($data);
260	next;
261	};
262	$first eq ' ' && do {
263	$data = substr( $data, 1 ); # trim
264	next;
265	};
266	$first eq '<' && do {
267	$xml = $data;
268	last;
269	};
270
271	last; # unexpected input
272	}
273
274	my @details;
275	push @details, "Timeout" if $timeout;
276	push @details, "User: $user" if $user;
277	push @details, "Password: " . ( $self->{debug} ? $password : ("x" x length($password)) ) if $password;
278	push @details, "Local user: $local_user" if $local_user;
279	unless ($xml) {
280	$self->log("Invalid request", $in, @details);
281	return;
282	}
283
284	$self->log("Request", @details);
285	$self->log($in) if $self->{debug};
286	return ($xml, $user, $password);
287	}
288
289	sub _trim_identifier {
290	my ($a, $len) = unpack "cc", substr( $_[0], 0, 2 );
291
292	return ( substr( $_[0], 2, $len ), substr( $_[0], 2 + $len ) );
293	}
294
295	sub handle_request {
296	my ( $self, $io ) = @_;
297
298	my ($data, $user, $password) = $self->read_request($io)
299	or return $self->error_response("Bad request");
300
301	my $ua;
302	if ($self->{user}) {
303	$user = $self->{user};
304	$password = $self->{password};
305	$ua = $self->{ua};
306	}
307	else {
308	$ua = _ua(); # fresh one, needs to authenticate
309	}
310
311	my $base_url = $self->{koha};
312	my $resp = $ua->post( $base_url.IMPORT_SVC_URI, $self->{params}, 'Content-Type' => 'text/plain', Content => $data );
313	my $status = $resp->code;
314	if ($status == HTTP_UNAUTHORIZED \|\| $status == HTTP_FORBIDDEN) {
315	my $user = $self->{user};
316	my $password = $self->{password};
317	$resp = $ua->post( $base_url.AUTH_URI, { userid => $user, password => $password } );
318	$resp = $ua->post( $base_url.IMPORT_SVC_URI, $self->{params}, 'Content-Type' => 'text/plain', Content => $data )
319	if $resp->is_success;
320	}
321	unless ($resp->is_success) {
322	$self->log("Unsuccessful request", $resp->request->as_string, $resp->as_string);
323	return $self->error_response("Unsuccessful request");
324	}
325
326	my ($koha_status, $bib, $batch_id, $error);
327	if ( my $r = eval { XMLin($resp->content) } ) {
328	$koha_status = $r->{status};
329	$batch_id = $r->{import_batch_id};
330	$error = $r->{error};
331	}
332	else {
333	$koha_status = "error";
334	$self->log("Response format error:\n$resp->content");
335	return $self->error_response("Invalid response");
336	}
337
338	if ($koha_status eq "ok") {
339	return $self->response( sprintf( "Success. Import batch id: %s", $batch_id ) );
340	}
341
342	return $self->error_response( sprintf( "%s. Please contact administrator.", $error ) );
343	}
344
345	sub error_response {
346	my $self = shift;
347	$self->response(@_);
348	}
349
350	sub response {
351	my $self = shift;
352	$self->log("Response: $_[0]");
353	printf $_[0] . "\0";
354	}
355
356
357	} # package
358

Line 0 Link Here

(-)a/misc/cronjobs/import_webservice_batch.pl (+57 lines)
	1	#!/usr/bin/perl -w
	2
	3	# Copyright 2012 CatalystIT
	4	#
	5	# This file is part of Koha.
	6	#
	7	# Koha 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	# Koha 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 Koha; if not, write to the Free Software Foundation, Inc.,
	18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
	19
	20	use strict;
	21	use warnings;
	22	use utf8;
	23
	24	BEGIN {
	25
	26	# find Koha's Perl modules
	27	# test carefully before changing this
	28	use FindBin;
	29	eval { require "$FindBin::Bin/../kohalib.pl" };
	30	}
	31
	32	use Getopt::Long;
	33	use Pod::Usage;
	34	use C4::ImportBatch;
	35
	36	my ($help, $framework);
	37
	38	GetOptions(
	39	'help\|?' => \$help,
	40	'framework=s' => \$framework,
	41	);
	42
	43	if($help){
	44	print <<EOF
	45	$0 --framework=myframework
	46	Parameters :
	47	--help\|? This message
	48	--framework default ""
	49	EOF
	50	;
	51	exit;
	52	}
	53
	54	my $batch_ids = GetStagedWebserviceBatches() or exit;
	55
	56	$framework \|\|= '';
	57	BatchCommitBibRecords($_, $framework) foreach @$batch_ids;

Line 0 Link Here

(-)a/svc/import_bib (+101 lines)
		1	#!/usr/bin/perl
		2
		3	# Copyright 2012 CatalystIT Ltd
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha 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	# Koha 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 Koha; if not, write to the Free Software Foundation, Inc.,
		18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		19	#
		20
		21	use strict;
		22	use warnings;
		23
		24	use CGI;
		25	use C4::Auth qw/check_api_auth/;
		26	use C4::Context;
		27	use C4::ImportBatch;
		28	use C4::Matcher;
		29	use XML::Simple;
		30	# use Carp::Always;
		31
		32	my $query = new CGI;
		33	binmode STDOUT, ':encoding(UTF-8)';
		34
		35	my ($status, $cookie, $sessionID) = check_api_auth($query, { editcatalogue => 'edit_catalogue'} );
		36	unless ($status eq "ok") {
		37	print $query->header(-type => 'text/xml', -status => '403 Forbidden');
		38	print XMLout({ auth_status => $status }, NoAttr => 1, RootName => 'response', XMLDecl => 1);
		39	exit 0;
		40	}
		41
		42	my $xml;
		43	if ($query->request_method eq "POST") {
		44	$xml = $query->param('POSTDATA');
		45	}
		46	if ($xml) {
		47	my %params = map { $_ => $query->url_param($_) } $query->url_param;
		48	my $result = import_bib($xml, \%params );
		49	print $query->header(-type => 'text/xml');
		50	print XMLout($result, NoAttr => 1, RootName => 'response', XMLDecl => 1);
		51	} else {
		52	print $query->header(-type => 'text/xml', -status => '400 Bad Request');
		53	}
		54
		55	exit 0;
		56
		57	sub import_bib {
		58	my ($inxml, $params) = @_;
		59
		60	my $result = {};
		61
		62	my $import_mode = delete $params->{import_mode} \|\| '';
		63	my $framework = delete $params->{framework} \|\| '';
		64
65	if (my $matcher_code = delete $params->{matcher}) {
66	$params->{matcher_id} = C4::Matcher::GetMatcherId($matcher_code);
67	}
68
69	my $batch_id = GetWebserviceBatchId($params);
70	unless ($batch_id) {
71	$result->{'status'} = "failed";
72	$result->{'error'} = "Batch create error";
73	return $result;
74	}
75
76	my $marcflavour = C4::Context->preference('marcflavour') \|\| 'MARC21';
77	my $marc_record = eval {MARC::Record::new_from_xml( $inxml, "utf8", $marcflavour)};
78	if ($@) {
79	$result->{'status'} = "failed";
80	$result->{'error'} = $@;
81	return $result;
82	}
83
84	my $import_record_id = AddBiblioToBatch($batch_id, 0, $marc_record, "utf8", int(rand(99999)));
85	my @import_items_ids = AddItemsToImportBiblio($batch_id, $import_record_id, $marc_record, 'UPDATE COUNTS');
86	my $marcxml = GetImportRecordMarcXML($import_record_id);
87	unless ($marcxml) {
88	$result->{'status'} = "failed";
89	$result->{'error'} = "database write error";
90	return $result;
91	}
92	$marcxml =~ s/<\?xml.*?\?>//i;
93
94	# XXX we are ignoring the result of this;
95	BatchCommitBibRecords($batch_id, $framework) if lc($import_mode) eq 'direct';
96
97	$result->{'status'} = "ok";
98	$result->{'import_batch_id'} = $batch_id;
99	$result->{'marcxml'} = $marcxml;
100	return $result;
101	}

Lines 1-31 Link Here

(-)a/t/db_dependent/lib/KohaTest/ImportBatch/AddImportBatch.pm (-31 lines)
1	package KohaTest::ImportBatch::AddImportBatch;
2	use base qw( KohaTest::ImportBatch );
3
4	use strict;
5	use warnings;
6
7	use Test::More;
8
9	use C4::ImportBatch;
10	use C4::Matcher;
11	use C4::Biblio;
12
13
14	=head3 add_one
15
16	=cut
17
18	sub add_one : Test( 1 ) {
19	my $self = shift;
20
21	my $batch_id = AddImportBatch(
22	'create_new', #overlay_action
23	'staging', # import_status
24	'batch', # batc_type
25	'foo', # file_name
26	'inserted during automated testing', # comments
27	);
28	ok( $batch_id, "successfully inserted batch: $batch_id" );
29	}
30
31	1;