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 |
- |
|
|