View | Details | Raw Unified | Return to bug 9032
Collapse All | Expand All

(-)a/opac/opac-shareshelf.pl (-87 / +99 lines)
Lines 6-12 Link Here
6
#
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
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
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 2 of the License, or (at your option) any later
9
# Foundation; either version 3 of the License, or (at your option) any later
10
# version.
10
# version.
11
#
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
Lines 21-26 use strict; Link Here
21
use warnings;
21
use warnings;
22
22
23
use constant KEYLENGTH => 10;
23
use constant KEYLENGTH => 10;
24
use constant TEMPLATE_NAME => 'opac-shareshelf.tmpl';
24
25
25
use CGI;
26
use CGI;
26
use Email::Valid;
27
use Email::Valid;
Lines 33-138 use C4::VirtualShelves; Link Here
33
34
34
#-------------------------------------------------------------------------------
35
#-------------------------------------------------------------------------------
35
36
36
my $query= new CGI;
37
my $pvar= _init( {} );
37
my ($shelfname, $owner);
38
if(! $pvar->{errcode} ) {
38
my ($template, $loggedinuser, $cookie);
39
    show_invite( $pvar ) if $pvar->{op} eq 'invite';
39
my $errcode=0;
40
    confirm_invite( $pvar ) if $pvar->{op} eq 'conf_invite';
40
my (@addr, $fail_addr, @newkey);
41
    show_accept( $pvar ) if $pvar->{op} eq 'accept';
41
my @base64alphabet= ('A'..'Z', 'a'..'z', 0..9, '+', '/');
42
}
42
43
load_template_vars( $pvar );
43
my $shelfnumber= $query->param('shelfnumber')||0;
44
output_html_with_http_headers $pvar->{query}, $pvar->{cookie},
44
my $op= $query->param('op')||'';
45
    $pvar->{template}->output;
45
my $addrlist= $query->param('invite_address')||'';
46
my $key= $query->param('key')||'';
47
46
48
#-------------------------------------------------------------------------------
47
#-------------------------------------------------------------------------------
49
48
50
check_common_errors();
49
sub _init {
51
load_template("opac-shareshelf.tmpl");
50
    my ($param) = @_;
52
if($errcode) {
51
    my $query = new CGI;
53
    #nothing to do
52
    $param->{query} = $query;
54
}
53
    $param->{shelfnumber} = $query->param('shelfnumber')||0;
55
elsif($op eq 'invite') {
54
    $param->{op} = $query->param('op')||'';
56
    show_invite();
55
    $param->{addrlist} = $query->param('invite_address')||'';
57
}
56
    $param->{key} = $query->param('key')||'';
58
elsif($op eq 'conf_invite') {
57
    $param->{appr_addr} = [];
59
    confirm_invite();
60
}
61
elsif($op eq 'accept') {
62
    show_accept();
63
}
64
load_template_vars();
65
output_html_with_http_headers $query, $cookie, $template->output;
66
58
67
#-------------------------------------------------------------------------------
59
    $param->{errcode} = check_common_errors($param);
60
    load_template($param);
61
    return $param;
62
}
68
63
69
sub check_common_errors {
64
sub check_common_errors {
70
    if($op!~/^(invite|conf_invite|accept)$/) {
65
    my ($param) = @_;
71
        $errcode=1; #no operation specified
66
    if( $param->{op} !~ /^(invite|conf_invite|accept)$/ ) {
72
        return;
67
        return 1; #no operation specified
73
    }
68
    }
74
    if($shelfnumber!~/^\d+$/) {
69
    if( $param->{shelfnumber} !~ /^\d+$/ ) {
75
        $errcode=2; #invalid shelf number
70
        return 2; #invalid shelf number
76
        return;
77
    }
71
    }
78
    if(!C4::Context->preference('OpacAllowSharingPrivateLists')) {
72
    if( ! C4::Context->preference('OpacAllowSharingPrivateLists') ) {
79
        $errcode=3; #not or no longer allowed?
73
        return 3; #not or no longer allowed?
80
        return;
81
    }
74
    }
75
    return;
82
}
76
}
83
77
84
sub show_invite {
78
sub show_invite {
85
    return unless check_owner_category();
79
    my ($param) = @_;
80
    return unless check_owner_category( $param );
86
}
81
}
87
82
88
sub confirm_invite {
83
sub confirm_invite {
89
    return unless check_owner_category();
84
    my ($param) = @_;
90
    process_addrlist();
85
    return unless check_owner_category( $param );
91
    if(@addr) {
86
    process_addrlist( $param );
92
        send_invitekey();
87
    if( @{$param->{appr_addr}} ) {
88
        send_invitekey( $param );
93
    }
89
    }
94
    else {
90
    else {
95
        $errcode=6; #not one valid address
91
        $param->{errcode}=6; #not one valid address
96
    }
92
    }
97
}
93
}
98
94
99
sub show_accept {
95
sub show_accept {
96
    my ($param) = @_;
100
    #TODO Add some code here to accept an invitation (followup report)
97
    #TODO Add some code here to accept an invitation (followup report)
101
}
98
}
102
99
103
sub process_addrlist {
100
sub process_addrlist {
104
    my @temp= split /[,:;]/, $addrlist;
101
    my ($param) = @_;
105
    $fail_addr='';
102
    my @temp= split /[,:;]/, $param->{addrlist};
103
    my @appr_addr;
104
    my $fail_addr='';
106
    foreach my $a (@temp) {
105
    foreach my $a (@temp) {
107
        $a=~s/^\s+//;
106
        $a=~s/^\s+//;
108
        $a=~s/\s+$//;
107
        $a=~s/\s+$//;
109
        if(IsEmailAddress($a)) {
108
        if( IsEmailAddress($a) ) {
110
            push @addr, $a;
109
            push @appr_addr, $a;
111
        }
110
        }
112
        else {
111
        else {
113
            $fail_addr.= ($fail_addr? '; ': '').$a;
112
            $fail_addr.= ($fail_addr? '; ': '').$a;
114
        }
113
        }
115
    }
114
    }
115
    $param->{appr_addr}= \@appr_addr;
116
    $param->{fail_addr}= $fail_addr;
116
}
117
}
117
118
118
sub send_invitekey {
119
sub send_invitekey {
120
    my ($param) = @_;
119
    my $fromaddr= C4::Context->preference('KohaAdminEmailAddress');
121
    my $fromaddr= C4::Context->preference('KohaAdminEmailAddress');
120
    my $url= 'http://'.C4::Context->preference('OPACBaseURL');
122
    my $url= 'http://'.C4::Context->preference('OPACBaseURL').
121
    $url.= "/cgi-bin/koha/opac-shareshelf.pl?shelfnumber=$shelfnumber";
123
        "/cgi-bin/koha/opac-shareshelf.pl?shelfnumber=".
122
    $url.= "&op=accept&key=";
124
        $param->{shelfnumber}."&op=accept&key=";
123
        #FIXME Waiting for the right http or https solution (BZ 8952 a.o.)
125
        #TODO Waiting for the right http or https solution (BZ 8952 a.o.)
124
126
125
    foreach my $a (@addr) {
127
    foreach my $a ( @{$param->{appr_addr}} ) {
126
        @newkey=randomlist(KEYLENGTH, 64); #generate a new key
128
        my @newkey= randomlist(KEYLENGTH, 64); #generate a new key
127
129
128
        #prepare letter
130
        #prepare letter
129
        my $letter= C4::Letters::GetPreparedLetter(
131
        my $letter= C4::Letters::GetPreparedLetter(
130
            module => 'members',
132
            module => 'members',
131
            letter_code => 'SHARE_INVITE',
133
            letter_code => 'SHARE_INVITE',
132
            branchcode => C4::Context->userenv->{"branch"},
134
            branchcode => C4::Context->userenv->{"branch"},
133
            tables => { borrowers => $loggedinuser, },
135
            tables => { borrowers => $param->{loggedinuser}, },
134
            substitute => {
136
            substitute => {
135
                listname => $shelfname,
137
                listname => $param->{shelfname},
136
                shareurl => $url.keytostring(\@newkey,0),
138
                shareurl => $url.keytostring(\@newkey,0),
137
            },
139
            },
138
        );
140
        );
Lines 145-185 sub send_invitekey { Link Here
145
            to_address             => $a,
147
            to_address             => $a,
146
        });
148
        });
147
        #add a preliminary share record
149
        #add a preliminary share record
148
        AddShare($shelfnumber,keytostring(\@newkey,1));
150
        AddShare( $param->{shelfnumber}, keytostring(\@newkey,1));
149
    }
151
    }
150
}
152
}
151
153
152
sub check_owner_category {
154
sub check_owner_category {
153
    #FIXME candidate for a module? what held me back is: getting back the two different error codes and the shelfname
155
    my ($param)= @_;
154
    (undef,$shelfname,$owner,my $category)= GetShelf($shelfnumber);
156
    #TODO candidate for a module?
155
    $errcode=4 if $owner!= $loggedinuser; #should be owner
157
    #need to get back the two different error codes and the shelfname
156
    $errcode=5 if !$errcode && $category!=1; #should be private
158
157
    return $errcode==0;
159
    ( undef, $param->{shelfname}, $param->{owner}, my $category ) =
160
    GetShelf( $param->{shelfnumber} );
161
    $param->{errcode}=4 if $param->{owner}!= $param->{loggedinuser};
162
    $param->{errcode}=5 if !$param->{errcode} && $category!=1;
163
        #should be private
164
    return !defined $param->{errcode};
158
}
165
}
159
166
160
sub load_template {
167
sub load_template {
161
    my ($file)= @_;
168
    my ($param)= @_;
162
    ($template, $loggedinuser, $cookie)= get_template_and_user({
169
    ($param->{template}, $param->{loggedinuser}, $param->{cookie} ) =
163
        template_name   => $file,
170
    get_template_and_user( {
164
        query           => $query,
171
        template_name   => TEMPLATE_NAME,
172
        query           => $param->{query},
165
        type            => "opac",
173
        type            => "opac",
166
        authnotrequired => 0, #should be a user
174
        authnotrequired => 0, #should be a user
167
    });
175
    } );
168
}
176
}
169
177
170
sub load_template_vars {
178
sub load_template_vars {
179
    my ($param) = @_;
180
    my $template = $param->{template};
181
    my $str= join '; ', @{$param->{appr_addr}};
171
    $template->param(
182
    $template->param(
172
        errcode         => $errcode,
183
        errcode         => $param->{errcode},
173
        op              => $op,
184
        op              => $param->{op},
174
        shelfnumber     => $shelfnumber,
185
        shelfnumber     => $param->{shelfnumber},
175
        shelfname       => $shelfname,
186
        shelfname       => $param->{shelfname},
176
        approvedaddress => (join '; ', @addr),
187
        approvedaddress => $str,
177
        failaddress     => $fail_addr,
188
        failaddress     => $param->{fail_addr},
178
    );
189
    );
179
}
190
}
180
191
181
sub IsEmailAddress {
192
sub IsEmailAddress {
182
    #FIXME candidate for a module?
193
    #TODO candidate for a module?
183
    return Email::Valid->address($_[0])? 1: 0;
194
    return Email::Valid->address($_[0])? 1: 0;
184
}
195
}
185
196
Lines 192-198 sub randomlist { Link Here
192
sub keytostring {
203
sub keytostring {
193
    my ($keyref, $flgBase64)= @_;
204
    my ($keyref, $flgBase64)= @_;
194
    if($flgBase64) {
205
    if($flgBase64) {
195
        return join '', map { base64chr($_); } @$keyref;
206
        my $alphabet= [ 'A'..'Z', 'a'..'z', 0..9, '+', '/' ];
207
        return join '', map { alphabet_char($_, $alphabet); } @$keyref;
196
    }
208
    }
197
    return join '', map { sprintf("%02d",$_); } @$keyref;
209
    return join '', map { sprintf("%02d",$_); } @$keyref;
198
}
210
}
Lines 201-207 sub stringtokey { Link Here
201
    my ($str, $flgBase64)= @_;
213
    my ($str, $flgBase64)= @_;
202
    my @temp=split '', $str||'';
214
    my @temp=split '', $str||'';
203
    if($flgBase64) {
215
    if($flgBase64) {
204
        return map { base64ord($_); } @temp;
216
        my $alphabet= [ 'A'..'Z', 'a'..'z', 0..9, '+', '/' ];
217
        return map { alphabet_ordinal($_, $alphabet); } @temp;
205
    }
218
    }
206
    return () if $str!~/^\d+$/;
219
    return () if $str!~/^\d+$/;
207
    my @retval;
220
    my @retval;
Lines 211-226 sub stringtokey { Link Here
211
    return @retval;
224
    return @retval;
212
}
225
}
213
226
214
sub base64ord { #base64 ordinal
227
sub alphabet_ordinal {
215
    my ($char)=@_;
228
    my ($char, $alphabet) = @_;
216
    return 0 -ord('A')+ord($char) if $char=~/[A-Z]/;
229
    for( 0..$#$alphabet ) {
217
    return 26-ord('a')+ord($char) if $char=~/[a-z]/;
230
        return $_ if $char eq $alphabet->[$_];
218
    return 52-ord('0')+ord($char) if $char=~/[0-9]/;
231
    }
219
    return 62 if $char eq '+';
232
    return ''; #ignore missing chars
220
    return 63 if $char eq '/';
221
    return;
222
}
233
}
223
234
224
sub base64chr { #reverse operation for ord
235
sub alphabet_char {
225
    return $_[0]=~/^\d+$/ && $_[0]<64? $base64alphabet[$_[0]]: undef;
236
#reverse operation for ordinal; ignore invalid numbers
237
    my ($num, $alphabet) = @_;
238
    return $num =~ /^\d+$/ && $num<=$#$alphabet? $alphabet->[$num]: '';
226
}
239
}
227
- 

Return to bug 9032