|
Lines 22-27
use warnings;
Link Here
|
| 22 |
|
22 |
|
| 23 |
use constant KEYLENGTH => 10; |
23 |
use constant KEYLENGTH => 10; |
| 24 |
use constant TEMPLATE_NAME => 'opac-shareshelf.tmpl'; |
24 |
use constant TEMPLATE_NAME => 'opac-shareshelf.tmpl'; |
|
|
25 |
use constant SHELVES_URL => '/cgi-bin/koha/opac-shelves.pl?display=privateshelves&viewshelf='; |
| 25 |
|
26 |
|
| 26 |
use CGI; |
27 |
use CGI; |
| 27 |
use Email::Valid; |
28 |
use Email::Valid; |
|
Lines 29-34
use Email::Valid;
Link Here
|
| 29 |
use C4::Auth; |
30 |
use C4::Auth; |
| 30 |
use C4::Context; |
31 |
use C4::Context; |
| 31 |
use C4::Letters; |
32 |
use C4::Letters; |
|
|
33 |
use C4::Members (); |
| 32 |
use C4::Output; |
34 |
use C4::Output; |
| 33 |
use C4::VirtualShelves; |
35 |
use C4::VirtualShelves; |
| 34 |
|
36 |
|
|
Lines 55-62
sub _init {
Link Here
|
| 55 |
$param->{addrlist} = $query->param('invite_address')||''; |
57 |
$param->{addrlist} = $query->param('invite_address')||''; |
| 56 |
$param->{key} = $query->param('key')||''; |
58 |
$param->{key} = $query->param('key')||''; |
| 57 |
$param->{appr_addr} = []; |
59 |
$param->{appr_addr} = []; |
| 58 |
|
60 |
$param->{fail_addr} = []; |
| 59 |
$param->{errcode} = check_common_errors($param); |
61 |
$param->{errcode} = check_common_errors($param); |
|
|
62 |
|
| 63 |
#get some list details |
| 64 |
my @temp; |
| 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; |
| 69 |
|
| 60 |
load_template($param); |
70 |
load_template($param); |
| 61 |
return $param; |
71 |
return $param; |
| 62 |
} |
72 |
} |
|
Lines 94-107
sub confirm_invite {
Link Here
|
| 94 |
|
104 |
|
| 95 |
sub show_accept { |
105 |
sub show_accept { |
| 96 |
my ($param) = @_; |
106 |
my ($param) = @_; |
| 97 |
#TODO Add some code here to accept an invitation (followup report) |
107 |
|
|
|
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 |
| 114 |
|
| 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}); |
| 120 |
exit; |
| 121 |
} |
| 122 |
else { |
| 123 |
$param->{errcode} = 7; #not accepted (key not found or expired) |
| 124 |
} |
| 125 |
} |
| 126 |
|
| 127 |
sub notify_owner { |
| 128 |
my ($param) = @_; |
| 129 |
|
| 130 |
my $toaddr= C4::Members::GetNoticeEmailAddress( $param->{owner} ); |
| 131 |
return if !$toaddr; |
| 132 |
|
| 133 |
#prepare letter |
| 134 |
my $letter= C4::Letters::GetPreparedLetter( |
| 135 |
module => 'members', |
| 136 |
letter_code => 'SHARE_ACCEPT', |
| 137 |
branchcode => C4::Context->userenv->{"branch"}, |
| 138 |
tables => { borrowers => $param->{loggedinuser}, }, |
| 139 |
substitute => { |
| 140 |
listname => $param->{shelfname}, |
| 141 |
}, |
| 142 |
); |
| 143 |
|
| 144 |
#send letter to queue |
| 145 |
C4::Letters::EnqueueLetter( { |
| 146 |
letter => $letter, |
| 147 |
message_transport_type => 'email', |
| 148 |
from_address => C4::Context->preference('KohaAdminEmailAddress'), |
| 149 |
to_address => $toaddr, |
| 150 |
}); |
| 98 |
} |
151 |
} |
| 99 |
|
152 |
|
| 100 |
sub process_addrlist { |
153 |
sub process_addrlist { |
| 101 |
my ($param) = @_; |
154 |
my ($param) = @_; |
| 102 |
my @temp= split /[,:;]/, $param->{addrlist}; |
155 |
my @temp= split /[,:;]/, $param->{addrlist}; |
| 103 |
my @appr_addr; |
156 |
my @appr_addr; |
| 104 |
my $fail_addr=''; |
157 |
my @fail_addr; |
| 105 |
foreach my $a (@temp) { |
158 |
foreach my $a (@temp) { |
| 106 |
$a=~s/^\s+//; |
159 |
$a=~s/^\s+//; |
| 107 |
$a=~s/\s+$//; |
160 |
$a=~s/\s+$//; |
|
Lines 109-119
sub process_addrlist {
Link Here
|
| 109 |
push @appr_addr, $a; |
162 |
push @appr_addr, $a; |
| 110 |
} |
163 |
} |
| 111 |
else { |
164 |
else { |
| 112 |
$fail_addr.= ($fail_addr? '; ': '').$a; |
165 |
push @fail_addr, $a; |
| 113 |
} |
166 |
} |
| 114 |
} |
167 |
} |
| 115 |
$param->{appr_addr}= \@appr_addr; |
168 |
$param->{appr_addr}= \@appr_addr; |
| 116 |
$param->{fail_addr}= $fail_addr; |
169 |
$param->{fail_addr}= \@fail_addr; |
| 117 |
} |
170 |
} |
| 118 |
|
171 |
|
| 119 |
sub send_invitekey { |
172 |
sub send_invitekey { |
|
Lines 124-132
sub send_invitekey {
Link Here
|
| 124 |
$param->{shelfnumber}."&op=accept&key="; |
177 |
$param->{shelfnumber}."&op=accept&key="; |
| 125 |
#TODO Waiting for the right http or https solution (BZ 8952 a.o.) |
178 |
#TODO Waiting for the right http or https solution (BZ 8952 a.o.) |
| 126 |
|
179 |
|
|
|
180 |
my @ok; #the addresses that were processed well |
| 127 |
foreach my $a ( @{$param->{appr_addr}} ) { |
181 |
foreach my $a ( @{$param->{appr_addr}} ) { |
| 128 |
my @newkey= randomlist(KEYLENGTH, 64); #generate a new key |
182 |
my @newkey= randomlist(KEYLENGTH, 64); #generate a new key |
| 129 |
|
183 |
|
|
|
184 |
#add a preliminary share record |
| 185 |
if( ! AddShare( $param->{shelfnumber}, keytostring(\@newkey,1) ) ) { |
| 186 |
push @{$param->{fail_addr}}, $a; |
| 187 |
next; |
| 188 |
} |
| 189 |
push @ok, $a; |
| 190 |
|
| 130 |
#prepare letter |
191 |
#prepare letter |
| 131 |
my $letter= C4::Letters::GetPreparedLetter( |
192 |
my $letter= C4::Letters::GetPreparedLetter( |
| 132 |
module => 'members', |
193 |
module => 'members', |
|
Lines 146-166
sub send_invitekey {
Link Here
|
| 146 |
from_address => $fromaddr, |
207 |
from_address => $fromaddr, |
| 147 |
to_address => $a, |
208 |
to_address => $a, |
| 148 |
}); |
209 |
}); |
| 149 |
#add a preliminary share record |
|
|
| 150 |
AddShare( $param->{shelfnumber}, keytostring(\@newkey,1)); |
| 151 |
} |
210 |
} |
|
|
211 |
$param->{appr_addr}= \@ok; |
| 152 |
} |
212 |
} |
| 153 |
|
213 |
|
| 154 |
sub check_owner_category { |
214 |
sub check_owner_category { |
| 155 |
my ($param)= @_; |
215 |
my ($param)= @_; |
| 156 |
#TODO candidate for a module? |
216 |
#sharing user should be the owner |
| 157 |
#need to get back the two different error codes and the shelfname |
217 |
#list should be private |
| 158 |
|
|
|
| 159 |
( undef, $param->{shelfname}, $param->{owner}, my $category ) = |
| 160 |
GetShelf( $param->{shelfnumber} ); |
| 161 |
$param->{errcode}=4 if $param->{owner}!= $param->{loggedinuser}; |
218 |
$param->{errcode}=4 if $param->{owner}!= $param->{loggedinuser}; |
| 162 |
$param->{errcode}=5 if !$param->{errcode} && $category!=1; |
219 |
$param->{errcode}=5 if !$param->{errcode} && $param->{category}!=1; |
| 163 |
#should be private |
|
|
| 164 |
return !defined $param->{errcode}; |
220 |
return !defined $param->{errcode}; |
| 165 |
} |
221 |
} |
| 166 |
|
222 |
|
|
Lines 178-191
sub load_template {
Link Here
|
| 178 |
sub load_template_vars { |
234 |
sub load_template_vars { |
| 179 |
my ($param) = @_; |
235 |
my ($param) = @_; |
| 180 |
my $template = $param->{template}; |
236 |
my $template = $param->{template}; |
| 181 |
my $str= join '; ', @{$param->{appr_addr}}; |
237 |
my $appr= join '; ', @{$param->{appr_addr}}; |
|
|
238 |
my $fail= join '; ', @{$param->{fail_addr}}; |
| 182 |
$template->param( |
239 |
$template->param( |
| 183 |
errcode => $param->{errcode}, |
240 |
errcode => $param->{errcode}, |
| 184 |
op => $param->{op}, |
241 |
op => $param->{op}, |
| 185 |
shelfnumber => $param->{shelfnumber}, |
242 |
shelfnumber => $param->{shelfnumber}, |
| 186 |
shelfname => $param->{shelfname}, |
243 |
shelfname => $param->{shelfname}, |
| 187 |
approvedaddress => $str, |
244 |
approvedaddress => $appr, |
| 188 |
failaddress => $param->{fail_addr}, |
245 |
failaddress => $fail, |
| 189 |
); |
246 |
); |
| 190 |
} |
247 |
} |
| 191 |
|
248 |
|
|
Lines 214-227
sub stringtokey {
Link Here
|
| 214 |
my @temp=split '', $str||''; |
271 |
my @temp=split '', $str||''; |
| 215 |
if($flgBase64) { |
272 |
if($flgBase64) { |
| 216 |
my $alphabet= [ 'A'..'Z', 'a'..'z', 0..9, '+', '/' ]; |
273 |
my $alphabet= [ 'A'..'Z', 'a'..'z', 0..9, '+', '/' ]; |
| 217 |
return map { alphabet_ordinal($_, $alphabet); } @temp; |
274 |
return [ map { alphabet_ordinal($_, $alphabet); } @temp ]; |
| 218 |
} |
275 |
} |
| 219 |
return () if $str!~/^\d+$/; |
276 |
return [] if $str!~/^\d+$/; |
| 220 |
my @retval; |
277 |
my @retval; |
| 221 |
for(my $i=0; $i<@temp-1; $i+=2) { |
278 |
for(my $i=0; $i<@temp-1; $i+=2) { |
| 222 |
push @retval, $temp[$i]*10+$temp[$i+1]; |
279 |
push @retval, $temp[$i]*10+$temp[$i+1]; |
| 223 |
} |
280 |
} |
| 224 |
return @retval; |
281 |
return \@retval; |
| 225 |
} |
282 |
} |
| 226 |
|
283 |
|
| 227 |
sub alphabet_ordinal { |
284 |
sub alphabet_ordinal { |
| 228 |
- |
|
|