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 855-861 CREATE TABLE `import_batches` ( Link Here
855
  `nomatch_action` enum('create_new', 'ignore') NOT NULL default 'create_new',
855
  `nomatch_action` enum('create_new', 'ignore') NOT NULL default 'create_new',
856
  `item_action` enum('always_add', 'add_only_for_matches', 'add_only_for_new', 'ignore') NOT NULL default 'always_add',
856
  `item_action` enum('always_add', 'add_only_for_matches', 'add_only_for_new', 'ignore') NOT NULL default 'always_add',
857
  `import_status` enum('staging', 'staged', 'importing', 'imported', 'reverting', 'reverted', 'cleaned') NOT NULL default 'staging',
857
  `import_status` enum('staging', 'staged', 'importing', 'imported', 'reverting', 'reverted', 'cleaned') NOT NULL default 'staging',
858
  `batch_type` enum('batch', 'z3950') NOT NULL default 'batch',
858
  `batch_type` enum('batch', 'z3950', 'webservice') NOT NULL default 'batch',
859
  `file_name` varchar(100),
859
  `file_name` varchar(100),
860
  `comments` mediumtext,
860
  `comments` mediumtext,
861
  PRIMARY KEY (`import_batch_id`),
861
  PRIMARY KEY (`import_batch_id`),
(-)a/installer/data/mysql/updatedatabase.pl (+10 lines)
Lines 4994-4999 if ( C4::Context->preference("Version") lt TransformToNum($DBversion) ) { Link Here
4994
    SetVersion($DBversion);
4994
    SetVersion($DBversion);
4995
}
4995
}
4996
4996
4997
4998
4999
5000
$DBversion = "3.07.00.XXX";
5001
if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
5002
    $dbh->do("ALTER TABLE import_batches MODIFY COLUMN batch_type ENUM('batch','z3950','webservice') NOT NULL default 'batch'");
5003
    print "Upgrade to $DBversion done (Add 'webservice' to batch_type enum)\n";
5004
    SetVersion ($DBversion);
5005
}
5006
4997
=head1 FUNCTIONS
5007
=head1 FUNCTIONS
4998
5008
4999
=head2 DropAllForeignKeys($table)
5009
=head2 DropAllForeignKeys($table)
(-)a/misc/bin/connexion_import_daemon.pl (+364 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, 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
    my $prefix = "";
155
    while ( my ($p, $v) = each %param ) {
156
        $prefix .= "$p: $v\n";
157
    }
158
159
    $self->{prefix} = $prefix;
160
}
161
162
sub log {
163
    my $self = shift;
164
    my $log_fh = $self->{log_fh}
165
      or warn "No log fh",
166
         return;
167
    my $t = localtime;
168
    print $log_fh map "$t: $_\n", @_;
169
}
170
171
sub background {
172
    my $self = shift;
173
174
    my $pid = fork;
175
    return ($pid) if $pid; # parent
176
177
    die "Couldn't fork: $!" unless defined($pid);
178
179
    POSIX::setsid() or die "Can't start a new session: $!";
180
181
    $SIG{INT} = $SIG{TERM} = $SIG{HUP} = sub { $self->{time_to_die} = 1 };
182
    # trap or ignore $SIG{PIPE}
183
    $SIG{USR1} = sub { $self->parse_config };
184
185
    $self->run;
186
}
187
188
sub run {
189
    my $self = shift;
190
191
    my $server_port = $self->{port};
192
    my $server_host = $self->{host};
193
194
    my $server = IO::Socket::INET->new(
195
        LocalHost => $server_host,
196
        LocalPort => $server_port,
197
        Type      => SOCK_STREAM,
198
        Proto     => "tcp",
199
        Listen    => 12,
200
        Blocking  => 1,
201
        ReuseAddr => 1,
202
    ) or die "Couldn't be a tcp server on port $server_port: $! $@";
203
204
    $self->log("Started tcp listener on $server_host:$server_port");
205
206
    $self->{ua} = _ua();
207
208
    while ("FOREVER") {
209
        my $client = $server->accept()
210
          or die "Cannot accept: $!";
211
        my $oldfh = select($client);
212
        $self->handle_request($client);
213
        select($oldfh);
214
        last if $self->{time_to_die};
215
    }
216
217
    close($server);
218
}
219
220
sub _ua {
221
    my $ua = LWP::UserAgent->new;
222
    $ua->timeout(10);
223
    $ua->cookie_jar({});
224
    return $ua;
225
}
226
227
sub read_request {
228
    my ( $self, $io ) = @_;
229
230
    my ($in, @in, $timeout);
231
    my $select = IO::Select->new($io) ;
232
    while ( "FOREVER" ) {
233
        if ( $select->can_read(CLIENT_READ_TIMEOUT) ){
234
            $io->recv($in, CLIENT_READ_BUFFER_SIZE);
235
            last unless $in;
236
237
            # XXX ignore after NULL
238
            if ( $in =~ m/^(.*)\000/so ) { # null received, EOT
239
                push @in, $1;
240
                last;
241
            }
242
            push @in, $in;
243
        }
244
        else {
245
            $timeout = 1;
246
            last;
247
        }
248
    }
249
250
    $in = join '', @in;
251
252
    my ($xml, $user, $password, $local_user);
253
    my $data = $in; # copy for diagmostic purposes
254
    while ( my $first = substr( $data, 0, 1 ) ) {
255
        $first eq 'U' && do {
256
            ($user, $data) = _trim_identifier($data);
257
            next;
258
        };
259
        $first eq 'A' && do {
260
            ($local_user, $data) = _trim_identifier($data);
261
            next;
262
        };
263
        $first eq 'P' && do {
264
            ($password,, $data) = _trim_identifier($data);
265
            next;
266
        };
267
        $first eq ' ' && do {
268
            $data = substr( $data, 1 );
269
            next;
270
        };
271
        $first eq '<' && do {
272
            $xml = $data;
273
            last;
274
        };
275
276
        last; # unexpected input
277
    }
278
279
    my @details;
280
    push @details, "Timeout" if $timeout;
281
    push @details, "User: $user" if $user;
282
    push @details, "Password: " . ( $self->{debug} ? $password : ("x" x length($password)) ) if $password;
283
    push @details, "Local user: $local_user" if $local_user;
284
    unless ($xml) {
285
        $self->log("Invalid request", $in, @details);
286
        return;
287
    }
288
289
    $self->log("Request", @details);
290
    $self->log($in) if $self->{debug};
291
    return ($xml, $user, $password);
292
}
293
294
sub _trim_identifier {
295
    my ($a, $len) = unpack "cc", substr( $_[0], 0, 2 );
296
297
    return ( substr( $_[0], 2, $len ), substr( $_[0], 2 + $len ) );
298
}
299
300
sub handle_request {
301
    my ( $self, $io ) = @_;
302
303
    my ($data, $user, $password) = $self->read_request($io)
304
      or return $self->error_response("Bad request");
305
306
    $data = $self->{prefix} . $data;
307
308
    my $ua;
309
    if ($self->{user}) {
310
        $user = $self->{user};
311
        $password = $self->{password};
312
        $ua = $self->{ua};
313
    }
314
    else {
315
        $ua  = _ua(); # fresh one, needs to authenticate
316
    }
317
318
    my $base_url = $self->{koha};
319
    my $resp = $ua->post( $base_url.IMPORT_SVC_URI, 'Content-Type' => 'text/plain', Content => $data );
320
    my $status = $resp->code;
321
    if ($status == HTTP_UNAUTHORIZED || $status == HTTP_FORBIDDEN) {
322
        my $user = $self->{user};
323
        my $password = $self->{password};
324
        $resp = $ua->post( $base_url.AUTH_URI, { userid => $user, password => $password } );
325
        $resp = $ua->post( $base_url.IMPORT_SVC_URI, 'Content-Type' => 'text/plain', Content => $data )
326
          if $resp->is_success;
327
    }
328
    unless ($resp->is_success) {
329
        $self->log("Unsuccessful request", $resp->request->as_string, $resp->as_string);
330
        return $self->error_response("Unsuccessful request");
331
    }
332
333
    my ($koha_status, $bib, $batch_id, $error);
334
    if ( my $r = eval { XMLin($resp->content) } ) {
335
        $koha_status = $r->{status};
336
        $batch_id    = $r->{import_batch_id};
337
        $error       = $r->{error};
338
    }
339
    else {
340
        $koha_status = "error";
341
        $self->log("Response format error:\n$resp->content");
342
        return $self->error_response("Invalid response");
343
    }
344
345
    if ($koha_status eq "ok") {
346
        return $self->response( sprintf( "Success. Import batch id: %s", $batch_id ) );
347
    }
348
349
    return $self->error_response( sprintf( "%s.  Please contact administrator.", $error ) );
350
}
351
352
sub error_response {
353
    my $self = shift;
354
    $self->response(@_);
355
}
356
357
sub response {
358
    my $self = shift;
359
    printf $_[0] . "\0";
360
}
361
362
363
} # package
364
(-)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; for debugging
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