3 # Copyright 2013 Rijksmuseum
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use constant KEYLENGTH => 10;
23 use constant TEMPLATE_NAME => 'opac-shareshelf.tt';
24 use constant SHELVES_URL =>
25 '/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);
64 if ( $param->{addrlist} ) {
65 $param->{addrlist} =~ s|^\s+||;
66 $param->{addrlist} =~ s|\s+$||;
69 #get some list details
71 @temp = GetShelf( $param->{shelfnumber} ) if !$param->{errcode};
72 $param->{shelfname} = @temp ? $temp[1] : '';
73 $param->{owner} = @temp ? $temp[2] : -1;
74 $param->{category} = @temp ? $temp[3] : -1;
76 load_template($param);
80 sub check_common_errors {
82 if ( $param->{op} !~ /^(invite|conf_invite|accept)$/ ) {
83 return 1; #no operation specified
85 if ( $param->{shelfnumber} !~ /^\d+$/ ) {
86 return 2; #invalid shelf number
88 if ( !C4::Context->preference('OpacAllowSharingPrivateLists') ) {
89 return 3; #not or no longer allowed?
96 return unless check_owner_category($param);
101 return unless check_owner_category($param);
102 process_addrlist($param);
103 if ( @{ $param->{appr_addr} } ) {
104 send_invitekey($param);
107 $param->{errcode} = 6; #not one valid address
114 my @rv = ShelfPossibleAction( $param->{loggedinuser},
115 $param->{shelfnumber}, 'acceptshare' );
116 $param->{errcode} = $rv[1] if !$rv[0];
117 return if $param->{errcode};
119 #errorcode 5: should be private list
120 #errorcode 8: should not be owner
122 my $dbkey = keytostring( stringtokey( $param->{key}, 0 ), 1 );
123 if ( AcceptShare( $param->{shelfnumber}, $dbkey, $param->{loggedinuser} ) )
125 notify_owner($param);
127 #redirect to view of this shared list
128 print $param->{query}->redirect(
129 -uri => SHELVES_URL . $param->{shelfnumber},
130 -cookie => $param->{cookie}
135 $param->{errcode} = 7; #not accepted (key not found or expired)
142 my $toaddr = C4::Members::GetNoticeEmailAddress( $param->{owner} );
146 my $letter = C4::Letters::GetPreparedLetter(
148 letter_code => 'SHARE_ACCEPT',
149 branchcode => C4::Context->userenv->{"branch"},
150 tables => { borrowers => $param->{loggedinuser}, },
151 substitute => { listname => $param->{shelfname}, },
154 #send letter to queue
155 C4::Letters::EnqueueLetter(
158 message_transport_type => 'email',
159 from_address => C4::Context->preference('KohaAdminEmailAddress'),
160 to_address => $toaddr,
165 sub process_addrlist {
167 my @temp = split /[,:;]/, $param->{addrlist};
170 foreach my $a (@temp) {
173 if ( IsEmailAddress($a) ) {
180 $param->{appr_addr} = \@appr_addr;
181 $param->{fail_addr} = \@fail_addr;
186 my $fromaddr = C4::Context->preference('KohaAdminEmailAddress');
188 C4::Context->preference('OPACBaseURL')
189 . "/cgi-bin/koha/opac-shareshelf.pl?shelfnumber="
190 . $param->{shelfnumber}
193 #TODO Waiting for the right http or https solution (BZ 8952 a.o.)
195 my @ok; #the addresses that were processed well
196 foreach my $a ( @{ $param->{appr_addr} } ) {
197 my @newkey = randomlist( KEYLENGTH, 64 ); #generate a new key
199 #add a preliminary share record
200 if ( !AddShare( $param->{shelfnumber}, keytostring( \@newkey, 1 ) ) ) {
201 push @{ $param->{fail_addr} }, $a;
207 my $letter = C4::Letters::GetPreparedLetter(
209 letter_code => 'SHARE_INVITE',
210 branchcode => C4::Context->userenv->{"branch"},
211 tables => { borrowers => $param->{loggedinuser}, },
213 listname => $param->{shelfname},
214 shareurl => $url . keytostring( \@newkey, 0 ),
218 #send letter to queue
219 C4::Letters::EnqueueLetter(
222 message_transport_type => 'email',
223 from_address => $fromaddr,
228 $param->{appr_addr} = \@ok;
231 sub check_owner_category {
234 #sharing user should be the owner
235 #list should be private
236 $param->{errcode} = 4 if $param->{owner} != $param->{loggedinuser};
237 $param->{errcode} = 5 if !$param->{errcode} && $param->{category} != 1;
238 return !defined $param->{errcode};
243 ( $param->{template}, $param->{loggedinuser}, $param->{cookie} ) =
244 get_template_and_user(
246 template_name => TEMPLATE_NAME,
247 query => $param->{query},
249 authnotrequired => 0, #should be a user
254 sub load_template_vars {
256 my $template = $param->{template};
257 my $appr = join '; ', @{ $param->{appr_addr} };
258 my $fail = join '; ', @{ $param->{fail_addr} };
260 errcode => $param->{errcode},
262 shelfnumber => $param->{shelfnumber},
263 shelfname => $param->{shelfname},
264 approvedaddress => $appr,
265 failaddress => $fail,
271 #TODO candidate for a module?
272 return Email::Valid->address( $_[0] ) ? 1 : 0;
277 #uses rand, safe enough for this application but not for more sensitive data
278 my ( $length, $base ) = @_;
279 return map { int( rand($base) ); } 1 .. $length;
283 my ( $keyref, $flgBase64 ) = @_;
285 my $alphabet = [ 'A' .. 'Z', 'a' .. 'z', 0 .. 9, '+', '/' ];
286 return join '', map { alphabet_char( $_, $alphabet ); } @$keyref;
288 return join '', map { sprintf( "%02d", $_ ); } @$keyref;
292 my ( $str, $flgBase64 ) = @_;
293 my @temp = split '', $str || '';
295 my $alphabet = [ 'A' .. 'Z', 'a' .. 'z', 0 .. 9, '+', '/' ];
296 return [ map { alphabet_ordinal( $_, $alphabet ); } @temp ];
298 return [] if $str !~ /^\d+$/;
300 for ( my $i = 0 ; $i < @temp - 1 ; $i += 2 ) {
301 push @retval, $temp[$i] * 10 + $temp[ $i + 1 ];
306 sub alphabet_ordinal {
307 my ( $char, $alphabet ) = @_;
308 for my $ord ( 0 .. $#$alphabet ) {
309 return $ord if $char eq $alphabet->[$ord];
311 return ''; #ignore missing chars
316 #reverse operation for ordinal; ignore invalid numbers
317 my ( $num, $alphabet ) = @_;
318 return $num =~ /^\d+$/ && $num <= $#$alphabet ? $alphabet->[$num] : '';