3 # Copyright 2013 Rijksmuseum
5 # This file is part of Koha.
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 3 of the License, or (at your option) any later
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.
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.
23 use constant KEYLENGTH => 10;
24 use constant TEMPLATE_NAME => 'opac-shareshelf.tmpl';
25 use constant SHELVES_URL => '/cgi-bin/koha/opac-shelves.pl?display=privateshelves&viewshelf=';
35 use C4::VirtualShelves;
37 #-------------------------------------------------------------------------------
39 my $pvar= _init( {} );
40 if(! $pvar->{errcode} ) {
41 show_invite( $pvar ) if $pvar->{op} eq 'invite';
42 confirm_invite( $pvar ) if $pvar->{op} eq 'conf_invite';
43 show_accept( $pvar ) if $pvar->{op} eq 'accept';
45 load_template_vars( $pvar );
46 output_html_with_http_headers $pvar->{query}, $pvar->{cookie},
47 $pvar->{template}->output;
49 #-------------------------------------------------------------------------------
54 $param->{query} = $query;
55 $param->{shelfnumber} = $query->param('shelfnumber')||0;
56 $param->{op} = $query->param('op')||'';
57 $param->{addrlist} = $query->param('invite_address')||'';
58 $param->{key} = $query->param('key')||'';
59 $param->{appr_addr} = [];
60 $param->{fail_addr} = [];
61 $param->{errcode} = check_common_errors($param);
63 #get some list details
65 @temp= GetShelf( $param->{shelfnumber} ) if !$param->{errcode};
66 $param->{shelfname} = @temp? $temp[1]: '';
67 $param->{owner} = @temp? $temp[2]: -1;
68 $param->{category} = @temp? $temp[3]: -1;
70 load_template($param);
74 sub check_common_errors {
76 if( $param->{op} !~ /^(invite|conf_invite|accept)$/ ) {
77 return 1; #no operation specified
79 if( $param->{shelfnumber} !~ /^\d+$/ ) {
80 return 2; #invalid shelf number
82 if( ! C4::Context->preference('OpacAllowSharingPrivateLists') ) {
83 return 3; #not or no longer allowed?
90 return unless check_owner_category( $param );
95 return unless check_owner_category( $param );
96 process_addrlist( $param );
97 if( @{$param->{appr_addr}} ) {
98 send_invitekey( $param );
101 $param->{errcode}=6; #not one valid address
108 my @rv= ShelfPossibleAction($param->{loggedinuser},
109 $param->{shelfnumber}, 'acceptshare');
110 $param->{errcode} = $rv[1] if !$rv[0];
111 return if $param->{errcode};
112 #errorcode 5: should be private list
113 #errorcode 8: should not be owner
115 my $dbkey= keytostring( stringtokey($param->{key}, 0), 1);
116 if( AcceptShare($param->{shelfnumber}, $dbkey, $param->{loggedinuser} ) ) {
117 notify_owner($param);
118 #redirect to view of this shared list
119 print $param->{query}->redirect(SHELVES_URL.$param->{shelfnumber});
123 $param->{errcode} = 7; #not accepted (key not found or expired)
130 my $toaddr= C4::Members::GetNoticeEmailAddress( $param->{owner} );
134 my $letter= C4::Letters::GetPreparedLetter(
136 letter_code => 'SHARE_ACCEPT',
137 branchcode => C4::Context->userenv->{"branch"},
138 tables => { borrowers => $param->{loggedinuser}, },
140 listname => $param->{shelfname},
144 #send letter to queue
145 C4::Letters::EnqueueLetter( {
147 message_transport_type => 'email',
148 from_address => C4::Context->preference('KohaAdminEmailAddress'),
149 to_address => $toaddr,
153 sub process_addrlist {
155 my @temp= split /[,:;]/, $param->{addrlist};
158 foreach my $a (@temp) {
161 if( IsEmailAddress($a) ) {
168 $param->{appr_addr}= \@appr_addr;
169 $param->{fail_addr}= \@fail_addr;
174 my $fromaddr= C4::Context->preference('KohaAdminEmailAddress');
175 my $url= 'http://'.C4::Context->preference('OPACBaseURL').
176 "/cgi-bin/koha/opac-shareshelf.pl?shelfnumber=".
177 $param->{shelfnumber}."&op=accept&key=";
178 #TODO Waiting for the right http or https solution (BZ 8952 a.o.)
180 my @ok; #the addresses that were processed well
181 foreach my $a ( @{$param->{appr_addr}} ) {
182 my @newkey= randomlist(KEYLENGTH, 64); #generate a new key
184 #add a preliminary share record
185 if( ! AddShare( $param->{shelfnumber}, keytostring(\@newkey,1) ) ) {
186 push @{$param->{fail_addr}}, $a;
192 my $letter= C4::Letters::GetPreparedLetter(
194 letter_code => 'SHARE_INVITE',
195 branchcode => C4::Context->userenv->{"branch"},
196 tables => { borrowers => $param->{loggedinuser}, },
198 listname => $param->{shelfname},
199 shareurl => $url.keytostring(\@newkey,0),
203 #send letter to queue
204 C4::Letters::EnqueueLetter( {
206 message_transport_type => 'email',
207 from_address => $fromaddr,
211 $param->{appr_addr}= \@ok;
214 sub check_owner_category {
216 #sharing user should be the owner
217 #list should be private
218 $param->{errcode}=4 if $param->{owner}!= $param->{loggedinuser};
219 $param->{errcode}=5 if !$param->{errcode} && $param->{category}!=1;
220 return !defined $param->{errcode};
225 ($param->{template}, $param->{loggedinuser}, $param->{cookie} ) =
226 get_template_and_user( {
227 template_name => TEMPLATE_NAME,
228 query => $param->{query},
230 authnotrequired => 0, #should be a user
234 sub load_template_vars {
236 my $template = $param->{template};
237 my $appr= join '; ', @{$param->{appr_addr}};
238 my $fail= join '; ', @{$param->{fail_addr}};
240 errcode => $param->{errcode},
242 shelfnumber => $param->{shelfnumber},
243 shelfname => $param->{shelfname},
244 approvedaddress => $appr,
245 failaddress => $fail,
250 #TODO candidate for a module?
251 return Email::Valid->address($_[0])? 1: 0;
255 #uses rand, safe enough for this application but not for more sensitive data
256 my ($length, $base)= @_;
257 return map { int(rand($base)); } 1..$length;
261 my ($keyref, $flgBase64)= @_;
263 my $alphabet= [ 'A'..'Z', 'a'..'z', 0..9, '+', '/' ];
264 return join '', map { alphabet_char($_, $alphabet); } @$keyref;
266 return join '', map { sprintf("%02d",$_); } @$keyref;
270 my ($str, $flgBase64)= @_;
271 my @temp=split '', $str||'';
273 my $alphabet= [ 'A'..'Z', 'a'..'z', 0..9, '+', '/' ];
274 return [ map { alphabet_ordinal($_, $alphabet); } @temp ];
276 return [] if $str!~/^\d+$/;
278 for(my $i=0; $i<@temp-1; $i+=2) {
279 push @retval, $temp[$i]*10+$temp[$i+1];
284 sub alphabet_ordinal {
285 my ($char, $alphabet) = @_;
286 for( 0..$#$alphabet ) {
287 return $_ if $char eq $alphabet->[$_];
289 return ''; #ignore missing chars
293 #reverse operation for ordinal; ignore invalid numbers
294 my ($num, $alphabet) = @_;
295 return $num =~ /^\d+$/ && $num<=$#$alphabet? $alphabet->[$num]: '';