From d44eca5f9100bc8bf61179953aaabdc5ca60a2f1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fr=C3=A9d=C3=A9ric=20Demians?= <f.demians@tamil.fr>
Date: Sun, 3 Nov 2013 17:05:38 +0100
Subject: [PATCH] Bug 11190 sitemap.pl -- Generate a Catalog sitemap

Add a script sitemap.pl to process all biblio records from a Koha
instance and generate Sitemap files complying with this protocol as
described on http://sitemaps.org. The goal of this script is to be able
to provide to search engines direct access to biblio records. It avoid
leaving search engine browsing Koha OPAC and so generating a lot of
traffic, and workload, for a bad result.
---
 C4/Installer/PerlDependencies.pm |   10 +++
 Koha/Sitemapper.pm               |   96 +++++++++++++++++++++++++++
 Koha/Sitemapper/Writer.pm        |  126 +++++++++++++++++++++++++++++++++++
 misc/cronjobs/sitemap.pl         |  134 ++++++++++++++++++++++++++++++++++++++
 t/Sitemapper.t                   |   11 +++
 5 files changed, 377 insertions(+), 0 deletions(-)
 create mode 100644 Koha/Sitemapper.pm
 create mode 100644 Koha/Sitemapper/Writer.pm
 create mode 100755 misc/cronjobs/sitemap.pl
 create mode 100755 t/Sitemapper.t

diff --git a/C4/Installer/PerlDependencies.pm b/C4/Installer/PerlDependencies.pm
index 9b4b3b6..a1ed724 100644
--- a/C4/Installer/PerlDependencies.pm
+++ b/C4/Installer/PerlDependencies.pm
@@ -629,6 +629,11 @@ our $PERL_DEPS = {
         'required' => '0',
         'min_ver'  => '2.13',
     },
+    'AnyEvent::HTTP' => {
+        'usage'    => 'Command line scripts',
+        'required' => '0',
+        'min_ver'  => '0.003',
+    },
     'Moose' => {
         'usage'    => 'Core',
         'required' => '0',
@@ -704,6 +709,11 @@ our $PERL_DEPS = {
         'required' => '0',
         'min_ver'  => '0.73',
     },
+    'XML::Writer' => {
+        'usage'    => 'Command line scripts',
+        'required' => '0',
+        'min_ver'  => '0.614',
+    },
 };
 
 1;
diff --git a/Koha/Sitemapper.pm b/Koha/Sitemapper.pm
new file mode 100644
index 0000000..e5aa394
--- /dev/null
+++ b/Koha/Sitemapper.pm
@@ -0,0 +1,96 @@
+package Koha::Sitemapper;
+
+#
+# Copyright 2013 Tamil s.a.r.l.
+#
+# 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 Moose;
+
+extends 'AnyEvent::Processor';
+
+use Modern::Perl;
+use Koha::Sitemapper::Writer;
+use C4::Context;
+
+
+has url => ( is => 'rw', isa => 'Str' );
+
+has dir => (
+    is => 'rw',
+    isa => 'Str',
+    default => '.',
+    trigger => sub {
+        my ($self, $dir) = @_;
+        unless (-d $dir) {
+            say "This is not a valid directory: $dir";
+            exit;
+        }
+    }
+);
+
+has short => ( is => 'rw', isa => 'Bool', default => 1 );
+
+has verbose => ( is => 'rw', isa => 'Bool', default => 0 );
+
+has sth => ( is => 'rw' );
+
+has writer => ( is => 'rw', isa => 'Koha::Sitemapper::Writer' );
+
+
+before 'run' => sub {
+    my $self = shift;
+
+    $self->writer( Koha::Sitemapper::Writer->new( sitemapper => $self ) );
+    my $sth = C4::Context->dbh->prepare(
+         "SELECT biblionumber, timestamp FROM biblio" );
+    $sth->execute();
+    $self->sth( $sth );
+};
+
+
+override 'process' => sub {
+    my $self = shift;
+
+    my ($biblionumber, $timestamp) = $self->sth->fetchrow;
+    return unless $biblionumber;
+
+    $self->writer->write($biblionumber, $timestamp);
+    return super();
+};
+
+
+before 'end_process' => sub { shift->writer->end(); };
+
+
+override 'start_message' => sub {
+    say "Creation of Sitemap files in '" . shift->dir . "' directory";
+};
+
+
+override 'end_message' => sub {
+    my $self = shift;
+    say "Number of biblio records processed: ", $self->count, "\n" .
+        "Number of Sitemap files:            ", $self->writer->count;
+};
+
+
+no Moose;
+__PACKAGE__->meta->make_immutable;
+
+
+1;
+
diff --git a/Koha/Sitemapper/Writer.pm b/Koha/Sitemapper/Writer.pm
new file mode 100644
index 0000000..b072fb8
--- /dev/null
+++ b/Koha/Sitemapper/Writer.pm
@@ -0,0 +1,126 @@
+package Koha::Sitemapper::Writer;
+
+#
+# Copyright 2014 Tamil s.a.r.l.
+#
+# 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 Moose;
+use Modern::Perl;
+use XML::Writer;
+use IO::File;
+use DateTime;
+
+
+my $MAX = 50000;
+
+
+has sitemapper => (is => 'rw', isa => 'Koha::Sitemapper');
+
+has current => ( is => 'rw', isa => 'Int', default => $MAX );
+
+has count => ( is => 'rw', isa => 'Int', default => 0 );
+
+has writer => ( is => 'rw', isa => 'XML::Writer' );
+
+
+
+sub _writer_create {
+    my ($self, $name) = @_;
+    $name = $self->sitemapper->dir . "/$name";
+    my $fh = IO::File->new(">/$name");
+    unless ($fh) {
+        say "Impossible to create file: $name";
+        exit;
+    }
+    my $writer = XML::Writer->new(
+        OUTPUT => $fh,
+        DATA_MODE => 1,
+        DATA_INDENT => 2,
+    );
+    $writer->xmlDecl("UTF-8");
+    return $writer;
+}
+
+
+sub _writer_end {
+    my $self = shift;
+    return unless $self->writer;
+    $self->writer->endTag();
+    $self->writer->end();
+}
+
+
+sub write {
+    my ($self, $biblionumber, $timestamp) = @_;
+
+    if ( $self->current == $MAX ) {
+        $self->_writer_end();
+        $self->count( $self->count + 1 );
+        my $w = $self->_writer_create( sprintf("sitemap%04d.xml", $self->count) );
+        $w->startTag(
+            'urlset',
+            'xmlns' => 'http://www.sitemaps.org/schemas/sitemap/0.9',
+            'xmlns:xsi' => 'http://www.w3.org/2001/XMLSchema-instance',
+            'xsi:schemaLocation' => 'http://www.sitemaps.org/schemas/sitemap/0.9 http://www.sitemaps.org/schemas/sitemap/0.9/sitemap.xsd');
+        $self->writer($w);
+        $self->current(0);
+    }
+
+    $self->current( $self->current + 1 );
+    my $writer = $self->writer;
+    my $url = $self->sitemapper->url .
+              ($self->sitemapper->short ? '/bib/' : '/cgi-bin/koha/opac-detail.pl?biblionumber=') .
+              $biblionumber;
+    $writer->startTag('url');
+        $writer->startTag('loc');
+            $writer->characters($url);
+        $writer->endTag();
+        $writer->startTag('lastmod');
+            $timestamp = substr($timestamp, 0, 10);
+            $writer->characters($timestamp);
+        $writer->endTag();
+    $writer->endTag();
+}
+
+
+sub end {
+    my $self = shift;
+
+    $self->_writer_end();
+
+    my $w = $self->_writer_create("sitemapindex.xml");
+    $w->startTag('sitemapindex', 'xmlns' => 'http://www.sitemaps.org/schemas/sitemap/0.9');
+    my $now = DateTime->now()->ymd;
+    for my $i ( 1..$self->count ) {
+        $w->startTag('sitemap');
+            $w->startTag('loc');
+                my $name = sprintf("sitemap%04d.xml", $i);
+                $w->characters($self->sitemapper->url . "/$name");
+            $w->endTag();
+            $w->startTag('lastmod');
+                $w->characters($now);
+            $w->endTag();
+        $w->endTag();
+    }
+    $w->endTag();
+}
+
+
+no Moose;
+1;
+
diff --git a/misc/cronjobs/sitemap.pl b/misc/cronjobs/sitemap.pl
new file mode 100755
index 0000000..8702167
--- /dev/null
+++ b/misc/cronjobs/sitemap.pl
@@ -0,0 +1,134 @@
+#!/usr/bin/perl
+
+#
+# Copyright 2014 Tamil s.a.r.l.
+#
+# 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.
+
+
+package Main;
+
+use Modern::Perl;
+use utf8;
+use Pod::Usage;
+use Getopt::Long;
+use C4::Biblio;
+use Koha::Sitemapper;
+
+
+my ($verbose, $help, $url, $dir, $short) = (0, 0, '', '.', 1);
+GetOptions( 
+    'verbose'   => \$verbose,
+    'help'      => \$help,
+    'url=s'     => \$url,
+    'dir=s'     => \$dir,
+    'short!'    => \$short,
+);
+
+sub usage {
+    pod2usage( -verbose => 2 );
+    exit;
+} 
+
+usage() if $help;
+
+unless ($url) {
+    $url = C4::Context->preference("OPACBaseURL");
+    unless ($url) {
+        say "OPACBaseURL syspref isn't defined. You can use --url parameter.";
+        exit;
+    }
+    $url = 'http://' . $url;
+}
+$url =~ s/\/*$//g;
+
+my $sitemaper = Koha::Sitemapper->new( 
+    verbose => $verbose,
+    url     => $url,
+    dir     => $dir,
+    short   => $short,
+);
+$sitemaper->run(); 
+
+
+=head1 USAGE
+
+=over
+
+=item sitemap.pl [--verbose|--help|--short|--noshort|--url|--dir]
+
+=back
+
+head 1 SYNOPSIS
+
+=over
+
+  sitemap.pl --verbose
+  sitemap.pl --noshort --url /home/koha/mylibrary/www
+
+=back
+
+=head1 DESCRIPTION
+
+Process all biblio records from a Koha instance and generate Sitemap files
+complying with this protocol as described on L<http://sitemaps.org>. The goal of
+this script is to be able to provide to search engines direct access to biblio
+records. It avoid leaving search engine browsing Koha OPAC and so generating
+a lot of traffic, and workload, for a bad result. 
+
+A file name F<sitemapindex.xml> is generated. It contains references to Sitemap
+multiples files. Each file contains at most 50,000 urls, and is named
+F<sitemapXXXX.xml>.
+
+The files must be stored on Koha OPAC root directoty, ie
+F<<koha-root>/koha-tmpl/>. Place also in this directory a F<robots.txt> file
+like this one:
+
+ Sitemap: sitemapindex.xml
+ User-agent: *
+ Disallow: /cgi-bin/
+
+=head1 PARAMETERS
+
+=over
+
+=item B<--url=Koha OPAC base URL>
+
+If omitted, OPACBaseURL syspref is used.
+
+=item B<--short|noshort>
+
+By default, --short. With --short, URL to bib record ends with
+/bib/biblionumber. With --noshort, URL ends with
+/cgi-bin/koha/opac-detail.pl?biblionumber=
+
+=item B<--dir>
+
+Directory where to write sitemap files. By default, the current directory.
+
+=item B<--verbose|-v>
+
+Enable script verbose mode: each minute, the number of biblio record links
+written is displayed.
+
+=item B<--help|-h>
+
+Print this help page.
+
+=back
+
+=cut
+
diff --git a/t/Sitemapper.t b/t/Sitemapper.t
new file mode 100755
index 0000000..b6175e4
--- /dev/null
+++ b/t/Sitemapper.t
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+#
+use Modern::Perl;
+
+use Test::More tests => 2;
+
+BEGIN {
+    use_ok('Koha::Sitemapper');
+    use_ok('Koha::Sitemapper::Writer');
+}
+
-- 
1.7.2.5