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

(-)a/C4/Breeding.pm (-7 / +1 lines)
Lines 76-88 sub ImportBreeding { Link Here
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
(-)a/C4/ImportBatch.pm (-13 / +103 lines)
Lines 35-44 BEGIN { Link Here
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;
190
191
}
192
193
=head2 AddImportBatch
149
194
150
    return $batch_id;
195
  my $batch_id = AddImportBatch($params_hash);
196
197
=cut
151
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 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);
(-)a/C4/Matcher.pm (+16 lines)
Lines 95-100 sub GetMatcherList { Link Here
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
(-)a/installer/data/mysql/kohastructure.sql (-1 / +1 lines)
Lines 851-857 CREATE TABLE `import_batches` ( Link Here
851
  `nomatch_action` enum('create_new', 'ignore') NOT NULL default 'create_new',
851
  `nomatch_action` enum('create_new', 'ignore') NOT NULL default 'create_new',
852
  `item_action` enum('always_add', 'add_only_for_matches', 'add_only_for_new', 'ignore') NOT NULL default 'always_add',
852
  `item_action` enum('always_add', 'add_only_for_matches', 'add_only_for_new', 'ignore') NOT NULL default 'always_add',
853
  `import_status` enum('staging', 'staged', 'importing', 'imported', 'reverting', 'reverted', 'cleaned') NOT NULL default 'staging',
853
  `import_status` enum('staging', 'staged', 'importing', 'imported', 'reverting', 'reverted', 'cleaned') NOT NULL default 'staging',
854
  `batch_type` enum('batch', 'z3950') NOT NULL default 'batch',
854
  `batch_type` enum('batch', 'z3950', 'webservice') NOT NULL default 'batch',
855
  `file_name` varchar(100),
855
  `file_name` varchar(100),
856
  `comments` mediumtext,
856
  `comments` mediumtext,
857
  PRIMARY KEY (`import_batch_id`),
857
  PRIMARY KEY (`import_batch_id`),
(-)a/installer/data/mysql/updatedatabase.pl (+7 lines)
Lines 4892-4897 if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) { Link Here
4892
    SetVersion($DBversion);
4892
    SetVersion($DBversion);
4893
}
4893
}
4894
4894
4895
$DBversion = "3.07.00.XXX";
4896
if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
4897
    $dbh->do("ALTER TABLE import_batches MODIFY COLUMN batch_type ENUM('batch','z3950','webservice') NOT NULL default 'batch'");
4898
    print "Upgrade to $DBversion done (Add 'webservice' to batch_type enum)\n";
4899
    SetVersion ($DBversion);
4900
}
4901
4895
=head1 FUNCTIONS
4902
=head1 FUNCTIONS
4896
4903
4897
=head2 DropAllForeignKeys($table)
4904
=head2 DropAllForeignKeys($table)
(-)a/misc/bin/connexion_import_daemon.pl (+263 lines)
Line 0 Link Here
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, defaults 80
51
  log      - log file path, stderr if omitted
52
  koha     - koha intranet base url, eg http://librarian.koha
53
  user     - koha user, authentication
54
  password - koha user password, authentication
55
  match          - marc_matchers.code: ISBN or ISSN
56
  overlay_action - import_batches.overlay_action: replace, create_new or ignore
57
  nomatch_action - import_batches.nomatch_action: create_new or ignore
58
  item_action    - import_batches.item_action:    always_add,
59
                      add_only_for_matches, add_only_for_new or ignore
60
  import_mode    - stage or direct
61
  framework      - to be used if import_mode is direct
62
63
  All process related parameters (all but ip and port) have default values as
64
  per Koha import process.
65
EOF
66
;
67
    exit;
68
}
69
70
my $server = ImportProxyServer->new;
71
$server->config_file($config);
72
73
if ($daemon) {
74
    print $server->background;
75
} else {
76
    $server->run;
77
}
78
79
80
{
81
package ImportProxyServer;
82
       
83
use base qw(HTTP::Server::Simple::CGI);
84
85
use LWP::UserAgent;
86
use HTTP::Status qw(:constants status_message);
87
use XML::Simple;
88
89
use constant AUTH_URI       => "/cgi-bin/koha/mainpage.pl";
90
use constant IMPORT_SVC_URI => "/cgi-bin/koha/svc/import_bib";
91
92
sub config_file {
93
    my $self = shift;
94
    $self->{'config_file'} = shift if (@_);
95
    return $self->{'config_file'};
96
97
}
98
99
sub parse_config {
100
    my $self = shift;
101
102
    my $config_file = $self->config_file or die "No config file";
103
104
    open CONF, $config_file or die "Cannot open config file $config: $!";
105
106
    my %param;
107
    my $line = 0;
108
    while (<CONF>) {
109
        $line++;
110
        chomp;
111
        s/\s*#.*//o; # remove comments
112
        s/^\s+//o;   # trim leading spaces
113
        s/\s+$//o;   # trim trailing spaces
114
        next unless $_;
115
        
116
        my ($p, $v) = m/(\S+?):\s*(.*)/o;
117
        die "Invalid config line $line: $_" unless defined $v;
118
        $param{$p} = $v;
119
    }
120
121
    $self->{LOCAL}->{koha} = delete( $param{koha} )
122
      or die "No koha base url in config file";
123
    $self->{LOCAL}->{user} = delete( $param{user} )
124
      or die "No koha user in config file";
125
    $self->{LOCAL}->{password} = delete( $param{password} )
126
      or die "No koha user password in config file";
127
128
    $self->host( delete $param{host} );
129
    $self->port( delete( $param{port} ) || 80 );
130
131
    my $log_fh;
132
    if (my $logfile = delete $param{log}) {
133
        open $log_fh, ">>$logfile" or die "Cannot open $logfile for write: $!";
134
    } else {
135
        $log_fh = \*STDERR;
136
    }
137
    $self->{LOCAL}->{log_fh} = $log_fh;
138
139
    my $prefix = "";
140
    while ( my ($p, $v) = each %param ) {
141
        $prefix .= "$p: $v\n";
142
    }
143
144
    $self->{LOCAL}->{prefix} = $prefix;
145
}
146
147
sub log {
148
    my $self = shift;
149
    my $log_fh = $self->{LOCAL}->{log_fh}
150
      or warn "No log fh",
151
         return;
152
    print $log_fh map "$_\n", @_;
153
}
154
155
sub print_banner {};
156
157
sub run {
158
    my $self = shift;
159
160
    $self->parse_config;
161
162
    my $ua = LWP::UserAgent->new;
163
    $ua->timeout(10);
164
    $ua->cookie_jar({});
165
    $self->{LOCAL}->{ua} = $ua;
166
167
    $self->SUPER::run(@_);
168
}
169
170
sub response_start {
171
    my ( $self, $status ) = @_;
172
    print "HTTP/1.0 $status ". status_message($status);
173
    print "\r\n";
174
#   print "Content-Type: text/html; charset='UTF-8'\r\n";
175
176
}
177
sub bad_req_error {
178
    my ( $self, $cgi ) = @_;
179
    $self->response_start(HTTP_BAD_REQUEST);
180
    die $cgi->headers->as_string, $cgi->param;
181
}
182
sub handle_request {
183
    my ( $self, $cgi ) = @_;
184
185
    my $data = $cgi->param('POSTDATA')
186
      or return $self->bad_req_error($cgi);
187
188
    $data = $self->{LOCAL}->{prefix} . $data;
189
190
    my $ua  = $self->{LOCAL}->{ua};
191
    my $base_url = $self->{LOCAL}->{koha};
192
    my $resp = $ua->post( $base_url.IMPORT_SVC_URI, 'Content-Type' => 'text/plain', Content => $data );
193
    my $status = $resp->code;
194
    if ($status == HTTP_UNAUTHORIZED || $status == HTTP_FORBIDDEN) {
195
        my $user = $self->{LOCAL}->{user};
196
        my $password = $self->{LOCAL}->{password};
197
        $resp = $ua->post( $base_url.AUTH_URI, { userid => $user, password => $password } );
198
        $resp = $ua->post( $base_url.IMPORT_SVC_URI, 'Content-Type' => 'text/plain', Content => $data )
199
          if $resp->is_success;
200
    }
201
    $self->log("Unsuccessful request", $resp->request->as_string, $resp->as_string)
202
      unless $resp->is_success;
203
204
    $self->response_start($resp->code);
205
    print $resp->headers->as_string;
206
    print "\r\n";
207
208
    if ($resp->is_success) {
209
        my ($koha_status, $bib, $batch_id, $error);
210
        if ( my $r = eval { XMLin($resp->content) } ) {
211
            $koha_status = $r->{status};
212
            $batch_id    = $r->{import_batch_id};
213
            $error       = $r->{error};
214
        }
215
        else {
216
            $koha_status = "error";
217
            $error       = "Response iformat error:\n$resp->content"
218
        }
219
220
        if ($koha_status eq "ok") {
221
            printf "Got it.  Thanks.\nImport batch id: %s\0", $batch_id;
222
        } else {
223
            printf "%s.  Please contact administrator.\0", $error;
224
        }
225
    }
226
    else {
227
        print $resp->content;
228
    }
229
}
230
231
} # package
232
=comment
233
use HTTP::Proxy;
234
use HTTP::Proxy::HeaderFilter::simple;
235
use HTTP::Proxy::BodyFilter::complete;
236
use HTTP::Proxy::BodyFilter::simple;
237
238
my $header_filter = HTTP::Proxy::HeaderFilter::simple->new(
239
    sub {
240
        my ( $self, $headers, $message) = @_;
241
        $headers->header('Content-Type' => 'text/plain');
242
        $message->url($svc_url);
243
    }
244
);
245
my $body_filter = HTTP::Proxy::BodyFilter::simple->new(
246
    sub {
247
        my ( $self, $dataref, $message, $protocol, $buffer) = @_;
248
        $$dataref = $prefix.$$dataref unless $buffer;
249
    }
250
);
251
my $proxy = HTTP::Proxy->new(
252
    host => $host,
253
    port => $port );
254
$proxy->push_filter(
255
    method => 'POST',
256
    request => $header_filter,
257
    request => HTTP::Proxy::BodyFilter::complete->new,
258
    request => $body_filter,
259
);
260
$proxy->start;
261
=cut
262
263
(-)a/misc/cronjobs/import_webservice_batch.pl (+57 lines)
Line 0 Link Here
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;
(-)a/svc/import_bib (+120 lines)
Line 0 Link Here
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 $in;
43
if ($query->request_method eq "POST") {
44
    $in = $query->param('POSTDATA');
45
}
46
if ($in) {
47
    my $result = import_bib($in);
48
    print $query->header(-type => 'text/xml');
49
    print XMLout($result, NoAttr => 1, RootName => 'response', XMLDecl => 1); 
50
} else {
51
    print $query->header(-type => 'text/xml', -status => '400 Bad Request');
52
}
53
54
exit 0;
55
56
sub import_bib {
57
    my ($in) = shift;
58
59
    my $result = {};
60
61
    unless ($in) {
62
        $result->{'status'} = "failed";
63
        $result->{'error'} = "Empty request";
64
        return $result;
65
    }
66
67
    my ($inparams,  $inxml) = ($in =~ m/^(.*)?(\<\?xml .*)$/s);
68
    unless ($inxml) {
69
        $result->{'status'} = "failed";
70
        $result->{'error'} = "No xml in the request\n$in";
71
        return $result;
72
    }
73
74
    my %params;
75
    if ($inparams) {
76
        # params are "p1: v1\np2: v2\np3: v3..."
77
        chomp $inparams;
78
        %params = map { split /:\s*/ } split "\n", $inparams;
79
    }
80
81
    my $import_mode = delete $params{import_mode} || '';
82
    my $framework   = delete $params{framework}   || '';
83
84
    if (my $matcher_code = delete $params{matcher}) {
85
        $params{matcher_id} = C4::Matcher::GetMatcherId($matcher_code);
86
    }
87
    
88
    my $batch_id = GetWebserviceBatchId(\%params);
89
    unless ($batch_id) {
90
        $result->{'status'} = "failed";
91
        $result->{'error'} = "Batch create error";
92
        return $result;
93
    }
94
95
    my $marcflavour = C4::Context->preference('marcflavour') || 'MARC21';
96
    my $marc_record = eval {MARC::Record::new_from_xml( $inxml, "utf8", $marcflavour)};
97
    if ($@) {
98
        $result->{'status'} = "failed";
99
        $result->{'error'} = $@;
100
        return $result;
101
    }
102
103
    my $import_record_id = AddBiblioToBatch($batch_id, 0, $marc_record, "utf8", int(rand(99999)));
104
    my @import_items_ids = AddItemsToImportBiblio($batch_id, $import_record_id, $marc_record, 0);
105
    my $marcxml = GetImportRecordMarcXML($import_record_id);
106
    unless ($marcxml) {
107
        $result->{'status'} = "failed";
108
        $result->{'error'} = "database write error";
109
        return $result;
110
    }
111
    $marcxml =~ s/<\?xml.*?\?>//i;
112
113
    # XXX we are ignoring the result of this;
114
    BatchCommitBibRecords($batch_id, $framework) if lc($import_mode) eq 'direct';
115
116
    $result->{'status'} = "ok";
117
    $result->{'import_batch_id'} =  $batch_id;
118
    $result->{'marcxml'} =  $marcxml;
119
    return $result;
120
}
(-)a/t/db_dependent/lib/KohaTest/ImportBatch.pm (-5 / +1 lines)
Lines 118-128 sub add_import_batch { Link Here
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
(-)a/t/db_dependent/lib/KohaTest/ImportBatch/AddImportBatch.pm (-31 lines)
Lines 1-31 Link Here
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;
(-)a/t/db_dependent/lib/KohaTest/ImportBatch/GetImportBatch.pm (-8 / +1 lines)
Lines 25-37 sub add_one_and_find_it : Test( 7 ) { Link Here
25
        file_name      => 'foo',
25
        file_name      => 'foo',
26
        comments       => 'inserted during automated testing',
26
        comments       => 'inserted during automated testing',
27
    };
27
    };
28
    my $batch_id = AddImportBatch(
28
    my $batch_id = AddImportBatch($batch);
29
      $batch->{'overlay_action'},
30
      $batch->{'import_status'},
31
      $batch->{'batch_type'},
32
      $batch->{'file_name'},
33
      $batch->{'comments'},
34
    );
35
    ok( $batch_id, "successfully inserted batch: $batch_id" );
29
    ok( $batch_id, "successfully inserted batch: $batch_id" );
36
30
37
    my $retrieved = GetImportBatch( $batch_id );
31
    my $retrieved = GetImportBatch( $batch_id );
38
- 

Return to bug 7613