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');
189 . C4
::Context
->preference('OPACBaseURL')
190 . "/cgi-bin/koha/opac-shareshelf.pl?shelfnumber="
191 . $param->{shelfnumber
}
194 #TODO Waiting for the right http or https solution (BZ 8952 a.o.)
196 my @ok; #the addresses that were processed well
197 foreach my $a ( @
{ $param->{appr_addr
} } ) {
198 my @newkey = randomlist
( KEYLENGTH
, 64 ); #generate a new key
200 #add a preliminary share record
201 if ( !AddShare
( $param->{shelfnumber
}, keytostring
( \
@newkey, 1 ) ) ) {
202 push @
{ $param->{fail_addr
} }, $a;
208 my $letter = C4
::Letters
::GetPreparedLetter
(
210 letter_code
=> 'SHARE_INVITE',
211 branchcode
=> C4
::Context
->userenv->{"branch"},
212 tables
=> { borrowers
=> $param->{loggedinuser
}, },
214 listname
=> $param->{shelfname
},
215 shareurl
=> $url . keytostring
( \
@newkey, 0 ),
219 #send letter to queue
220 C4
::Letters
::EnqueueLetter
(
223 message_transport_type
=> 'email',
224 from_address
=> $fromaddr,
229 $param->{appr_addr
} = \
@ok;
232 sub check_owner_category
{
235 #sharing user should be the owner
236 #list should be private
237 $param->{errcode
} = 4 if $param->{owner
} != $param->{loggedinuser
};
238 $param->{errcode
} = 5 if !$param->{errcode
} && $param->{category
} != 1;
239 return !defined $param->{errcode
};
244 ( $param->{template
}, $param->{loggedinuser
}, $param->{cookie
} ) =
245 get_template_and_user
(
247 template_name
=> TEMPLATE_NAME
,
248 query
=> $param->{query
},
250 authnotrequired
=> 0, #should be a user
255 sub load_template_vars
{
257 my $template = $param->{template
};
258 my $appr = join '; ', @
{ $param->{appr_addr
} };
259 my $fail = join '; ', @
{ $param->{fail_addr
} };
261 errcode
=> $param->{errcode
},
263 shelfnumber
=> $param->{shelfnumber
},
264 shelfname
=> $param->{shelfname
},
265 approvedaddress
=> $appr,
266 failaddress
=> $fail,
272 #TODO candidate for a module?
273 return Email
::Valid
->address( $_[0] ) ?
1 : 0;
278 #uses rand, safe enough for this application but not for more sensitive data
279 my ( $length, $base ) = @_;
280 return map { int( rand($base) ); } 1 .. $length;
284 my ( $keyref, $flgBase64 ) = @_;
286 my $alphabet = [ 'A' .. 'Z', 'a' .. 'z', 0 .. 9, '+', '/' ];
287 return join '', map { alphabet_char
( $_, $alphabet ); } @
$keyref;
289 return join '', map { sprintf( "%02d", $_ ); } @
$keyref;
293 my ( $str, $flgBase64 ) = @_;
294 my @temp = split '', $str || '';
296 my $alphabet = [ 'A' .. 'Z', 'a' .. 'z', 0 .. 9, '+', '/' ];
297 return [ map { alphabet_ordinal
( $_, $alphabet ); } @temp ];
299 return [] if $str !~ /^\d+$/;
301 for ( my $i = 0 ; $i < @temp - 1 ; $i += 2 ) {
302 push @retval, $temp[$i] * 10 + $temp[ $i + 1 ];
307 sub alphabet_ordinal
{
308 my ( $char, $alphabet ) = @_;
309 for my $ord ( 0 .. $#$alphabet ) {
310 return $ord if $char eq $alphabet->[$ord];
312 return ''; #ignore missing chars
317 #reverse operation for ordinal; ignore invalid numbers
318 my ( $num, $alphabet ) = @_;
319 return $num =~ /^\d+$/ && $num <= $#$alphabet ? $alphabet->[$num] : '';