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 (-32 / +118 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;
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 {
(-)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 858-864 CREATE TABLE `import_batches` ( Link Here
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`),
(-)a/installer/data/mysql/updatedatabase.pl (+10 lines)
Lines 5086-5091 if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) { Link Here
5086
    SetVersion($DBversion);
5086
    SetVersion($DBversion);
5087
}
5087
}
5088
5088
5089
5090
5091
5092
$DBversion = "3.07.00.XXX";
5093
if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
5094
    $dbh->do("ALTER TABLE import_batches MODIFY COLUMN batch_type ENUM('batch','z3950','webservice') NOT NULL default 'batch'");
5095
    print "Upgrade to $DBversion done (Add 'webservice' to batch_type enum)\n";
5096
    SetVersion ($DBversion);
5097
}
5098
5089
=head1 FUNCTIONS
5099
=head1 FUNCTIONS
5090
5100
5091
=head2 DropAllForeignKeys($table)
5101
=head2 DropAllForeignKeys($table)
(-)a/misc/bin/connexion_import_daemon.pl (+358 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
    $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
(-)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 (+101 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 $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
}
(-)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 (-7 / +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 );
(-)a/tools/manage-marc-import.pl (-2 / +1 lines)
Lines 218-224 sub import_batches_list { Link Here
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