Merge remote-tracking branch 'origin/new/bug_7781'
authorPaul Poulain <paul.poulain@biblibre.com>
Fri, 6 Apr 2012 16:22:19 +0000 (18:22 +0200)
committerPaul Poulain <paul.poulain@biblibre.com>
Fri, 6 Apr 2012 16:22:19 +0000 (18:22 +0200)
23 files changed:
C4/Breeding.pm
C4/Circulation.pm
C4/ImportBatch.pm
C4/Items.pm
C4/Matcher.pm
C4/Search.pm
circ/circulation.pl
installer/data/mysql/kohastructure.sql
installer/data/mysql/updatedatabase.pl
koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/opac.pref
koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/searching.pref
koha-tmpl/intranet-tmpl/prog/en/modules/circ/circulation.tt
koha-tmpl/intranet-tmpl/prog/en/modules/members/moremember.tt
kohaversion.pl
members/moremember.pl
misc/bin/connexion_import_daemon.pl [new file with mode: 0755]
misc/cronjobs/import_webservice_batch.pl [new file with mode: 0755]
opac/opac-detail.pl
svc/import_bib [new file with mode: 0755]
t/db_dependent/lib/KohaTest/ImportBatch.pm
t/db_dependent/lib/KohaTest/ImportBatch/AddImportBatch.pm [deleted file]
t/db_dependent/lib/KohaTest/ImportBatch/GetImportBatch.pm
tools/manage-marc-import.pl

index 9003f9a..c588c64 100644 (file)
@@ -76,13 +76,7 @@ sub ImportBreeding {
     
     my $dbh = C4::Context->dbh;
     
-    my $batch_id = 0;
-    if ($batch_type eq 'z3950') {
-        $batch_id = GetZ3950BatchId($filename);
-    } else {
-        # create a new one
-        $batch_id = AddImportBatch('create_new', 'staging', 'batch', $filename, '');
-    }
+    my $batch_id = GetZ3950BatchId($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
index 9c43f36..6ca860d 100644 (file)
@@ -36,7 +36,7 @@ use C4::Message;
 use C4::Debug;
 use C4::Branch; # GetBranches
 use C4::Log; # logaction
-
+use C4::Koha qw(GetAuthorisedValueByCode);
 use Data::Dumper;
 use Koha::DateUtils;
 use Koha::Calendar;
@@ -848,6 +848,9 @@ sub CanBookBeIssued {
     {
         $issuingimpossible{RESTRICTED} = 1;
     }
+    if ( $item->{'itemlost'} ) {
+        $needsconfirmation{ITEM_LOST} = GetAuthorisedValueByCode( 'LOST', $item->{'itemlost'} );
+    }
     if ( C4::Context->preference("IndependantBranches") ) {
         my $userenv = C4::Context->userenv;
         if ( ($userenv) && ( $userenv->{flags} % 2 != 1 ) ) {
index 63cc60b..8d4a488 100644 (file)
@@ -35,10 +35,13 @@ BEGIN {
        @ISA    = qw(Exporter);
        @EXPORT = qw(
     GetZ3950BatchId
+    GetWebserviceBatchId
     GetImportRecordMarc
+    GetImportRecordMarcXML
     AddImportBatch
     GetImportBatch
     AddBiblioToBatch
+    AddItemsToImportBiblio
     ModBiblioInBatch
 
     BatchStageMarcRecords
@@ -48,6 +51,7 @@ BEGIN {
     CleanBatch
 
     GetAllImportBatches
+    GetStagedWebserviceBatches
     GetImportBatchRangeDesc
     GetNumberOfNonZ3950ImportBatches
     GetImportBibliosRange
@@ -105,12 +109,51 @@ sub GetZ3950BatchId {
     if (defined $rowref) {
         return $rowref->[0];
     } else {
-        my $batch_id = AddImportBatch('create_new', 'staged', 'z3950', $z3950server, '');
+        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);
@@ -129,26 +172,48 @@ sub GetImportRecordMarc {
 
 }
 
-=head2 AddImportBatch
+=head2 GetImportRecordMarcXML
 
-  my $batch_id = AddImportBatch($overlay_action, $import_status, $type, 
-                                $file_name, $comments);
+  my $marcxml = GetImportRecordMarcXML($import_record_id);
 
 =cut
 
-sub AddImportBatch {
-    my ($overlay_action, $import_status, $type, $file_name, $comments) = @_;
+sub GetImportRecordMarcXML {
+    my ($import_record_id) = @_;
 
     my $dbh = C4::Context->dbh;
-    my $sth = $dbh->prepare("INSERT INTO import_batches (overlay_action, import_status, batch_type,
-                                                         file_name, comments)
-                                    VALUES (?, ?, ?, ?, ?)");
-    $sth->execute($overlay_action, $import_status, $type, $file_name, $comments);
-    my $batch_id = $dbh->{'mysql_insertid'};
+    my $sth = $dbh->prepare("SELECT marcxml FROM import_records WHERE import_record_id = ?");
+    $sth->execute($import_record_id);
+    my ($marcxml) = $sth->fetchrow();
     $sth->finish();
+    return $marcxml;
 
-    return $batch_id;
+}
+
+=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 
@@ -237,7 +302,13 @@ sub  BatchStageMarcRecords {
         $progress_interval = 0 unless 'CODE' eq ref $progress_callback;
     } 
     
-    my $batch_id = AddImportBatch('create_new', 'staging', 'batch', $file_name, $comments);
+    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 {
@@ -688,7 +759,7 @@ ascending order by import_batch_id.
 sub  GetAllImportBatches {
     my $dbh = C4::Context->dbh;
     my $sth = $dbh->prepare_cached("SELECT * FROM import_batches
-                                    WHERE batch_type = 'batch'
+                                    WHERE batch_type IN ('batch', 'webservice')
                                     ORDER BY import_batch_id ASC");
 
     my $results = [];
@@ -700,6 +771,25 @@ sub  GetAllImportBatches {
     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);
@@ -715,7 +805,7 @@ sub GetImportBatchRangeDesc {
 
     my $dbh = C4::Context->dbh;
     my $query = "SELECT * FROM import_batches
-                                    WHERE batch_type = 'batch'
+                                    WHERE batch_type IN ('batch', 'webservice')
                                     ORDER BY import_batch_id DESC";
     my @params;
     if ($results_per_group){
@@ -759,7 +849,7 @@ sub GetItemNumbersFromImportBatch {
 
 sub GetNumberOfNonZ3950ImportBatches {
     my $dbh = C4::Context->dbh;
-    my $sth = $dbh->prepare("SELECT COUNT(*) FROM import_batches WHERE batch_type='batch'");
+    my $sth = $dbh->prepare("SELECT COUNT(*) FROM import_batches WHERE batch_type != 'z3950'");
     $sth->execute();
     my ($count) = $sth->fetchrow_array();
     $sth->finish();
@@ -1196,26 +1286,22 @@ sub _update_batch_record_counts {
     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')
-                                    WHERE import_batch_id = ?");
-    $sth->bind_param(1, $batch_id);
-    $sth->execute();
-    $sth->finish();
-    $sth = $dbh->prepare_cached("UPDATE import_batches SET 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')
+    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')
                                     WHERE import_batch_id = ?");
     $sth->bind_param(1, $batch_id);
     $sth->execute();
     $sth->finish();
-
 }
 
 sub _get_commit_action {
index 0b2f99b..4790091 100644 (file)
@@ -26,7 +26,6 @@ use C4::Context;
 use C4::Koha;
 use C4::Biblio;
 use C4::Dates qw/format_date format_date_in_iso/;
-use C4::Search qw/SimpleSearch/;
 use MARC::Record;
 use C4::ClassSource;
 use C4::Log;
index 9d1df67..d61964c 100644 (file)
@@ -95,6 +95,22 @@ sub GetMatcherList {
     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
index 56468b5..33a1d16 100644 (file)
@@ -733,6 +733,13 @@ sub _build_stemmed_operand {
 
 # FIXME: the locale should be set based on the user's language and/or search choice
     #warn "$lang";
+    # Make sure we only use the first two letters from the language code
+    $lang = lc(substr($lang, 0, 2));
+    # The language codes for the two variants of Norwegian will now be "nb" and "nn",
+    # none of which Lingua::Stem::Snowball can use, so we need to "translate" them
+    if ($lang eq 'nb' || $lang eq 'nn') {
+      $lang = 'no';
+    }
     my $stemmer = Lingua::Stem::Snowball->new( lang => $lang,
                                                encoding => "UTF-8" );
 
index 2c93547..bcbcb6f 100755 (executable)
@@ -355,7 +355,7 @@ if ($borrowernumber) {
         $getreserv{biblionumber}   = $getiteminfo->{'biblionumber'};
         $getreserv{waitingat}      = GetBranchName( $num_res->{'branchcode'} );
         $getreserv{suspend}        = $num_res->{'suspend'};
-        $getreserv{suspend_until}  = C4::Dates->new( $num_res->{'suspend_until'}, "iso")->output("syspref");
+        $getreserv{suspend_until}  = $num_res->{'suspend_until'};
         #         check if we have a waiting status for reservations
         if ( $num_res->{'found'} eq 'W' ) {
             $getreserv{color}   = 'reserved';
index 4912e19..03911fe 100644 (file)
@@ -858,7 +858,7 @@ CREATE TABLE `import_batches` (
   `nomatch_action` enum('create_new', 'ignore') NOT NULL default 'create_new',
   `item_action` enum('always_add', 'add_only_for_matches', 'add_only_for_new', 'ignore') NOT NULL default 'always_add',
   `import_status` enum('staging', 'staged', 'importing', 'imported', 'reverting', 'reverted', 'cleaned') NOT NULL default 'staging',
-  `batch_type` enum('batch', 'z3950') NOT NULL default 'batch',
+  `batch_type` enum('batch', 'z3950', 'webservice') NOT NULL default 'batch',
   `file_name` varchar(100),
   `comments` mediumtext,
   PRIMARY KEY (`import_batch_id`),
@@ -990,6 +990,7 @@ CREATE TABLE `issuingrules` (
   `chargename` varchar(100) default NULL,
   `maxissueqty` int(4) default NULL,
   `issuelength` int(4) default NULL,
+  `lengthunit` varchar(10) default 'days',
   `hardduedate` date default NULL,
   `hardduedatecompare` tinyint NOT NULL default "0",
   `renewalsallowed` smallint(6) NOT NULL default "0",
index 503c8ee..b3c5691 100755 (executable)
@@ -5019,7 +5019,6 @@ if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
     $dbh->do("ALTER TABLE old_issues CHANGE returndate returndate datetime");
     $dbh->do("ALTER TABLE old_issues CHANGE lastreneweddate lastreneweddate datetime");
     $dbh->do("ALTER TABLE old_issues CHANGE issuedate issuedate datetime");
-    $dbh->do("alter table issuingrules add column lengthunit varchar(10) default 'days' after issuelength");
     print "Upgrade to $DBversion done (Setting up issues tables for hourly loans)\n";
     SetVersion($DBversion);
 }
@@ -5146,6 +5145,20 @@ if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
     SetVersion($DBversion);
 }
 
+$DBversion = "3.07.00.045";
+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);
+}
+
+$DBversion = "3.07.00.046";
+if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) {
+    $dbh->do("ALTER TABLE issuingrules ADD COLUMN lengthunit varchar(10) DEFAULT 'days' AFTER issuelength");
+    print "Upgrade to $DBversion done (Setting up issues tables for hourly loans (lengthunit fix))\n";
+    SetVersion($DBversion);
+}
+
 =head1 FUNCTIONS
 
 =head2 DropAllForeignKeys($table)
index a871399..54cc43a 100644 (file)
@@ -308,6 +308,13 @@ OPAC:
             - pref: numSearchRSSResults
               class: long
             -  search results in the RSS feed.
+        -
+            - pref: SocialNetworks
+              default: 0
+              choices:
+                  yes: Enable
+                  no: Disable
+            - social network links in opac detail pages
     Policy:
         -
             - pref: singleBranchMode
index 7b5993d..3d7dd64 100644 (file)
@@ -76,13 +76,6 @@ Searching:
                   yes: Using
                   no: "Not using"
             - 'ICU Zebra indexing. Please note: This setting will not affect Zebra indexing, it should only be used to tell Koha that you have activated ICU indexing if you have actually done so, since there is no way for Koha to figure this out on its own.'
-        -
-            - pref: SocialNetworks
-              default: 0
-              choices:
-                  yes: Enable
-                  no: Disable
-            - Enable/Disable social network links in opac detail pages
     Search Form:
         -
             - Show tabs in OPAC and staff-side advanced search for limiting searches on the
index 57c16ee..55dca62 100644 (file)
@@ -275,9 +275,14 @@ function refocus(calendar) {
 [% IF ( NOT_FOR_LOAN_FORCING ) %]
     <li>Item is normally not for loan.  Check out anyway?</li>
 [% END %]
+
 [% IF ( USERBLOCKEDOVERDUE ) %]
     <li>Patron has [% USERBLOCKEDOVERDUE %] overdue item(s).  Check out anyway?</li>
 [% END %]
+
+[% IF ( ITEM_LOST ) %]
+    <li>This item has been lost with a status of "[% ITEM_LOST %]". Check out anyway?</li>
+[% END %]
 </ul>
 
 <form method="post" action="/cgi-bin/koha/circ/circulation.pl" autocomplete="off">
@@ -977,18 +982,18 @@ No patron matched <span class="ex">[% message %]</span>
                 <input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
                 <input type="hidden" name="reservenumber" value="[% reservloo.reservenumber %]" />
             </td>
-            <td>[% IF ( reservloo.suspend ) %]Suspended [% IF ( reservloo.suspend_until ) %] until [% reservloo.suspend_until %][% END %][% END %]</td>
+            <td>[% IF ( reservloo.suspend ) %]Suspended [% IF ( reservloo.suspend_until ) %] until [% reservloo.suspend_until | $KohaDates %][% END %][% END %]</td>
             </tr>
         [% END %]</tbody>
     </table>
-               <fieldset class="action"><input type="submit" class="cancel" name="submit" value="Cancel Marked Requests" /></fieldset>
+            <fieldset class="action"><input type="submit" class="cancel" name="submit" value="Cancel marked holds" /></fieldset>
     </form>
 
     <fieldset class="action">
         <form action="/cgi-bin/koha/reserve/modrequest_suspendall.pl" method="post">
             <input type="hidden" name="from" value="circ" />
             <input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
-            <input type="submit" value="Suspend All Requests" />
+            <input type="submit" value="Suspend all holds" />
 
             [% IF AutoResumeSuspendedHolds %]
             <label for="suspend_until">until</label>
@@ -1032,7 +1037,7 @@ No patron matched <span class="ex">[% message %]</span>
             <input type="hidden" name="from" value="circ" />
             <input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
             <input type="hidden" name="suspend" value="0" />
-            <input type="submit" value="Resume All Suspended All Requests" />
+            <input type="submit" value="Resume all suspended holds" />
        </form>
     </fieldset>
 
index b568ec9..0c8287a 100644 (file)
@@ -638,18 +638,18 @@ function validate1(date) {
                 <input type="hidden" name="biblionumber" value="[% reservloo.biblionumber %]" />
                 <input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
             </td>
-            <td>[% IF ( reservloo.suspend ) %]Suspended [% IF ( reservloo.suspend_until ) %] until [% reservloo.suspend_until %][% END %][% END %]</td>
+            <td>[% IF ( reservloo.suspend ) %]Suspended [% IF ( reservloo.suspend_until ) %] until [% reservloo.suspend_until | $KohaDates %][% END %][% END %]</td>
         </tr>
                [% END %]</tbody>
     </table>
 
-        <fieldset class="action"><input type="submit" class="cancel" name="submit" value="Cancel Marked Requests" /></fieldset>
+        <fieldset class="action"><input type="submit" class="cancel" name="submit" value="Cancel marked holds" /></fieldset>
     </form>
     <fieldset class="action">
         <form action="/cgi-bin/koha/reserve/modrequest_suspendall.pl" method="post">
             <input type="hidden" name="from" value="borrower" />
             <input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
-            <input type="submit" value="Suspend All Requests" />
+            <input type="submit" value="Suspend all holds" />
 
             [% IF AutoResumeSuspendedHolds %]
             <label for="suspend_until">until</label>
@@ -693,7 +693,7 @@ function validate1(date) {
             <input type="hidden" name="from" value="borrower" />
             <input type="hidden" name="borrowernumber" value="[% borrowernumber %]" />
             <input type="hidden" name="suspend" value="0" />
-            <input type="submit" value="Resume All Suspended All Requests" />
+            <input type="submit" value="Resume all suspended holds" />
        </form>
     </fieldset>
 
index 00d03c1..8ef42a3 100644 (file)
@@ -16,7 +16,7 @@ the kohaversion is divided in 4 parts :
 use strict;
 
 sub kohaversion {
-    our $VERSION = '3.07.00.044';
+    our $VERSION = '3.07.00.046';
     # version needs to be set this way
     # so that it can be picked up by Makefile.PL
     # during install
index 32541c9..cc9afb9 100755 (executable)
@@ -321,7 +321,7 @@ if ($borrowernumber) {
         }
         $getreserv{waitingposition} = $num_res->{'priority'};
         $getreserv{suspend} = $num_res->{'suspend'};
-        $getreserv{suspend_until} = C4::Dates->new( $num_res->{'suspend_until'}, "iso")->output("syspref");;
+        $getreserv{suspend_until} = $num_res->{'suspend_until'};
 
         push( @reservloop, \%getreserv );
     }
diff --git a/misc/bin/connexion_import_daemon.pl b/misc/bin/connexion_import_daemon.pl
new file mode 100755 (executable)
index 0000000..9d32f8a
--- /dev/null
@@ -0,0 +1,357 @@
+#!/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 (my $conf_fh, '<', $config_file) or die "Cannot open config file $config: $!";
+
+    my %param;
+    my $line = 0;
+    while (<$conf_fh>) {
+        $line++;
+        chomp;
+        s/\s*#.*//o; # remove comments
+        s/^\s+//o;   # trim leading spaces
+        s/\s+$//o;   # trim trailing spaces
+        next unless $_;
+
+        my ($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
diff --git a/misc/cronjobs/import_webservice_batch.pl b/misc/cronjobs/import_webservice_batch.pl
new file mode 100755 (executable)
index 0000000..d1b30ef
--- /dev/null
@@ -0,0 +1,57 @@
+#!/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;
index a00e976..796f3b0 100755 (executable)
@@ -148,7 +148,8 @@ if ($session->param('busc')) {
         for (my $i=0;$i<@servers;$i++) {
             my $server = $servers[$i];
             $hits = $results_hashref->{$server}->{"hits"};
-            @newresults = searchResults('opac', '', $hits, $results_per_page, $offset, $arrParamsBusc->{'scan'}, @{$results_hashref->{$server}->{"RECORDS"}},, C4::Context->preference('hidelostitems'));
+            my @records = $results_hashref->{$server}->{"RECORDS"};
+            @newresults = searchResults('opac', '', $hits, $results_per_page, $offset, $arrParamsBusc->{'scan'}, \@records,, C4::Context->preference('hidelostitems'));
         }
         return \@newresults;
     }#searchAgain
diff --git a/svc/import_bib b/svc/import_bib
new file mode 100755 (executable)
index 0000000..5e7e493
--- /dev/null
@@ -0,0 +1,101 @@
+#!/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;
+}
index a8fefaa..743b1aa 100644 (file)
@@ -118,11 +118,7 @@ sub add_import_batch {
         file_name      => 'foo',
         comments       => 'inserted during automated testing',
       };
-    my $batch_id = AddImportBatch( $test_batch->{'overlay_action'},
-                                   $test_batch->{'import_status'},
-                                   $test_batch->{'batch_type'},
-                                   $test_batch->{'file_name'},
-                                   $test_batch->{'comments'}, );
+    my $batch_id = AddImportBatch( $test_batch );
     return $batch_id;
 }
 
diff --git a/t/db_dependent/lib/KohaTest/ImportBatch/AddImportBatch.pm b/t/db_dependent/lib/KohaTest/ImportBatch/AddImportBatch.pm
deleted file mode 100644 (file)
index 7b97e72..0000000
+++ /dev/null
@@ -1,31 +0,0 @@
-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;
index 0b01707..6f436c5 100644 (file)
@@ -25,13 +25,7 @@ sub add_one_and_find_it : Test( 7 ) {
         file_name      => 'foo',
         comments       => 'inserted during automated testing',
     };
-    my $batch_id = AddImportBatch(
-      $batch->{'overlay_action'},
-      $batch->{'import_status'},
-      $batch->{'batch_type'},
-      $batch->{'file_name'},
-      $batch->{'comments'},
-    );
+    my $batch_id = AddImportBatch($batch);
     ok( $batch_id, "successfully inserted batch: $batch_id" );
 
     my $retrieved = GetImportBatch( $batch_id );
index cc22aeb..8a8d9e8 100755 (executable)
@@ -218,7 +218,7 @@ sub import_batches_list {
             num_items => $batch->{'num_items'},
             upload_timestamp => $batch->{'upload_timestamp'},
             import_status => $batch->{'import_status'},
-            file_name => $batch->{'file_name'},
+            file_name => $batch->{'file_name'} || "($batch->{'batch_type'})",
             comments => $batch->{'comments'},
             can_clean => ($batch->{'import_status'} ne 'cleaned') ? 1 : 0,
         };