@@ -, +, @@ invitation) --- C4/VirtualShelves.pm | 29 ++- .../opac-tmpl/prog/en/modules/opac-shareshelf.tt | 69 ++++++ .../opac-tmpl/prog/en/modules/opac-shelves.tt | 18 +- opac/opac-shareshelf.pl | 226 ++++++++++++++++++++ 4 files changed, 340 insertions(+), 2 deletions(-) create mode 100644 koha-tmpl/opac-tmpl/prog/en/modules/opac-shareshelf.tt create mode 100755 opac/opac-shareshelf.pl --- a/C4/VirtualShelves.pm +++ a/C4/VirtualShelves.pm @@ -29,6 +29,8 @@ use constant SHELVES_COMBO_MAX => 10; #add to combo in search use constant SHELVES_MGRPAGE_MAX => 20; #managing page use constant SHELVES_POPUP_MAX => 40; #addbybiblio popup +use constant SHARE_INVITATION_EXPIRY_DAYS => 14; #two weeks to accept + use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); BEGIN { @@ -42,7 +44,7 @@ BEGIN { &ModShelf &ShelfPossibleAction &DelFromShelf &DelShelf - &GetBibliosShelves + &GetBibliosShelves &AddShare ); @EXPORT_OK = qw( &GetAllShelves &ShelvesMax @@ -640,6 +642,31 @@ sub HandleDelBorrower { $dbh->do($query,undef,($borrower)); } +=head2 AddShare + + AddShare($shelfnumber, $key); + +Adds a share request to the virtualshelves table. +Authorization must have been checked, and a key must be supplied. See script +opac-shareshelf.pl for an example. +This request is not yet confirmed. So it has no borrowernumber, it does have an +expiry date. + +=cut + +sub AddShare { + my ($shelfnumber, $key)= @_; + return if !$shelfnumber || !$key; + + my $sql; + my $dbh = C4::Context->dbh; + $sql="DELETE FROM virtualshelfshares WHERE sharedatedo($sql); + $sql="INSERT INTO virtualshelfshares (shelfnumber, invitekey, sharedate) VALUES (?, ?, ADDDATE(NOW(),?))"; + $dbh->do($sql, undef, ($shelfnumber, $key, SHARE_INVITATION_EXPIRY_DAYS)); +} + # internal subs sub _shelf_count { --- a/koha-tmpl/opac-tmpl/prog/en/modules/opac-shareshelf.tt +++ a/koha-tmpl/opac-tmpl/prog/en/modules/opac-shareshelf.tt @@ -0,0 +1,69 @@ +[% INCLUDE 'doc-head-open.inc' %][% IF ( LibraryNameTitle ) %][% LibraryNameTitle %][% ELSE %]Koha online[% END %] catalog › Share a list +[% INCLUDE 'doc-head-close.inc' %] + + +
+
+[% INCLUDE 'masthead.inc' %] + +
+
+ +[%# This section contains the essential code for error messages and three operations: invite, confirm_invite and accept. %] +

Share a list with another patron

+ [% IF errcode %] + [% IF errcode==1 && op %]
The operation [% op %] is not supported.
[% END %] + [% IF errcode==1 && !op %]
No operation parameter has been passed.
[% END %] + [% IF errcode==2 %]
Invalid shelf number.
[% END %] + [% IF errcode==3 %]
The feature of sharing lists is not in use in this library.
[% END %] + [% IF errcode==4 %]
You can only share a list if you are the owner.
[% END %] + [% IF errcode==5 %]
You cannot share a public list.
[% END %] + [% IF errcode==6 %]
Sorry, but you did not enter any valid email address.
[% END %] + + [% ELSIF op=='invite' %] +
+ + + + + + + + + + + +
[% shelfname %]
+ +
+ + [% ELSIF op=='conf_invite' %] +

We have sent invitation emails to share list [% shelfname %] to the mail queue for [% approvedaddress %].

+ [% IF failaddress %] +

The following addresses appear to be invalid. Please correct them and try again. These are: [% failaddress %]

+ [% END %] +

You will be notified if someone accepts your share within two weeks.

+ + [% ELSIF op=='accept' %] + [%# TODO: Replace the following two lines %] +

Thank you for testing this feature.

+

Your signoff will certainly help in finishing the remaining part!

+ + [% END %] +[%# End of essential part %] + +
+
+
+ +[% IF ( OpacNav ) %] +
+
+ [% INCLUDE 'navigation.inc' %] +
+
+[% END %] + +
+
+[% INCLUDE 'opac-bottom.inc' %] --- a/koha-tmpl/opac-tmpl/prog/en/modules/opac-shelves.tt +++ a/koha-tmpl/opac-tmpl/prog/en/modules/opac-shelves.tt @@ -1,3 +1,4 @@ +[% USE Koha %] [% SET TagsShowEnabled = ( TagsEnabled && TagsShowOnList ) %] [% SET TagsInputEnabled = ( opacuserlogin && TagsEnabled && TagsInputOnList ) %] @@ -349,7 +350,15 @@ $(document).ready(function() { [% IF ( showprivateshelves ) %][% END %] - [% END %] + + [% IF showprivateshelves && Koha.Preference('OpacAllowSharingPrivateLists') %] +
+ + + +
+ [% END %] + [% END %] @@ -629,7 +638,14 @@ $(document).ready(function() { [% ELSE %] [% END %] + + [% IF Koha.Preference('OpacAllowSharingPrivateLists') %] +
+ + +
+ [% END %] [% END %]  --- a/opac/opac-shareshelf.pl +++ a/opac/opac-shareshelf.pl @@ -0,0 +1,226 @@ +#!/usr/bin/perl + +# Copyright 2013 Rijksmuseum +# +# 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 constant KEYLENGTH => 10; + +use CGI; +use Email::Valid; + +use C4::Auth; +use C4::Context; +use C4::Letters; +use C4::Output; +use C4::VirtualShelves; + +#------------------------------------------------------------------------------- + +my $query= new CGI; +my ($shelfname, $owner); +my ($template, $loggedinuser, $cookie); +my $errcode=0; +my (@addr, $fail_addr, @newkey); +my @base64alphabet= ('A'..'Z', 'a'..'z', 0..9, '+', '/'); + +my $shelfnumber= $query->param('shelfnumber')||0; +my $op= $query->param('op')||''; +my $addrlist= $query->param('invite_address')||''; +my $key= $query->param('key')||''; + +#------------------------------------------------------------------------------- + +check_common_errors(); +load_template("opac-shareshelf.tmpl"); +if($errcode) { + #nothing to do +} +elsif($op eq 'invite') { + show_invite(); +} +elsif($op eq 'conf_invite') { + confirm_invite(); +} +elsif($op eq 'accept') { + show_accept(); +} +load_template_vars(); +output_html_with_http_headers $query, $cookie, $template->output; + +#------------------------------------------------------------------------------- + +sub check_common_errors { + if($op!~/^(invite|conf_invite|accept)$/) { + $errcode=1; #no operation specified + return; + } + if($shelfnumber!~/^\d+$/) { + $errcode=2; #invalid shelf number + return; + } + if(!C4::Context->preference('OpacAllowSharingPrivateLists')) { + $errcode=3; #not or no longer allowed? + return; + } +} + +sub show_invite { + return unless check_owner_category(); +} + +sub confirm_invite { + return unless check_owner_category(); + process_addrlist(); + if(@addr) { + send_invitekey(); + } + else { + $errcode=6; #not one valid address + } +} + +sub show_accept { + #TODO Add some code here to accept an invitation (followup report) +} + +sub process_addrlist { + my @temp= split /[,:;]/, $addrlist; + $fail_addr=''; + foreach my $a (@temp) { + $a=~s/^\s+//; + $a=~s/\s+$//; + if(IsEmailAddress($a)) { + push @addr, $a; + } + else { + $fail_addr.= ($fail_addr? '; ': '').$a; + } + } +} + +sub send_invitekey { + my $fromaddr= C4::Context->preference('KohaAdminEmailAddress'); + my $url= 'http://'.C4::Context->preference('OPACBaseURL'); + $url.= "/cgi-bin/koha/opac-shareshelf.pl?shelfnumber=$shelfnumber"; + $url.= "&op=accept&key="; + #FIXME Waiting for the right http or https solution (BZ 8952 a.o.) + + foreach my $a (@addr) { + @newkey=randomlist(KEYLENGTH, 64); #generate a new key + + #prepare letter + my $letter= C4::Letters::GetPreparedLetter( + module => 'members', + letter_code => 'SHARE_INVITE', + branchcode => C4::Context->userenv->{"branch"}, + tables => { borrowers => $loggedinuser, }, + substitute => { + listname => $shelfname, + shareurl => $url.keytostring(\@newkey,0), + }, + ); + + #send letter to queue + C4::Letters::EnqueueLetter( { + letter => $letter, + message_transport_type => 'email', + from_address => $fromaddr, + to_address => $a, + }); + #add a preliminary share record + AddShare($shelfnumber,keytostring(\@newkey,1)); + } +} + +sub check_owner_category { + #FIXME candidate for a module? what held me back is: getting back the two different error codes and the shelfname + (undef,$shelfname,$owner,my $category)= GetShelf($shelfnumber); + $errcode=4 if $owner!= $loggedinuser; #should be owner + $errcode=5 if !$errcode && $category!=1; #should be private + return $errcode==0; +} + +sub load_template { + my ($file)= @_; + ($template, $loggedinuser, $cookie)= get_template_and_user({ + template_name => $file, + query => $query, + type => "opac", + authnotrequired => 0, #should be a user + }); +} + +sub load_template_vars { + $template->param( + errcode => $errcode, + op => $op, + shelfnumber => $shelfnumber, + shelfname => $shelfname, + approvedaddress => (join '; ', @addr), + failaddress => $fail_addr, + ); +} + +sub IsEmailAddress { + #FIXME candidate for a module? + return Email::Valid->address($_[0])? 1: 0; +} + +sub randomlist { +#uses rand, safe enough for this application but not for more sensitive data + my ($length, $base)= @_; + return map { int(rand($base)); } 1..$length; +} + +sub keytostring { + my ($keyref, $flgBase64)= @_; + if($flgBase64) { + return join '', map { base64chr($_); } @$keyref; + } + return join '', map { sprintf("%02d",$_); } @$keyref; +} + +sub stringtokey { + my ($str, $flgBase64)= @_; + my @temp=split '', $str||''; + if($flgBase64) { + return map { base64ord($_); } @temp; + } + return () if $str!~/^\d+$/; + my @retval; + for(my $i=0; $i<@temp-1; $i+=2) { + push @retval, $temp[$i]*10+$temp[$i+1]; + } + return @retval; +} + +sub base64ord { #base64 ordinal + my ($char)=@_; + return 0 -ord('A')+ord($char) if $char=~/[A-Z]/; + return 26-ord('a')+ord($char) if $char=~/[a-z]/; + return 52-ord('0')+ord($char) if $char=~/[0-9]/; + return 62 if $char eq '+'; + return 63 if $char eq '/'; + return; +} + +sub base64chr { #reverse operation for ord + return $_[0]=~/^\d+$/ && $_[0]<64? $base64alphabet[$_[0]]: undef; +} --