opac/opac-shareshelf.pl

   1 #!/usr/bin/perl
   2
   3 # Copyright 2013 Rijksmuseum
   4 #
   5 # This file is part of Koha.
   6 #
   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
   9 # Foundation; either version 3 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use strict;
  21 use warnings;
  22
  23 use constant KEYLENGTH => 10;
  24 use constant TEMPLATE_NAME => 'opac-shareshelf.tmpl';
  25 use constant SHELVES_URL => '/cgi-bin/koha/opac-shelves.pl?display=privateshelves&viewshelf=';
  26
  27 use CGI;
  28 use Email::Valid;
  29
  30 use C4::Auth;
  31 use C4::Context;
  32 use C4::Letters;
  33 use C4::Members ();
  34 use C4::Output;
  35 use C4::VirtualShelves;
  36
  37 #-------------------------------------------------------------------------------
  38
  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';
  44 }
  45 load_template_vars( $pvar );
  46 output_html_with_http_headers $pvar->{query}, $pvar->{cookie},
  47     $pvar->{template}->output;
  48
  49 #-------------------------------------------------------------------------------
  50
  51 sub _init {
  52     my ($param) = @_;
  53     my $query = new CGI;
  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);
  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
  70     load_template($param);
  71     return $param;
  72 }
  73
  74 sub check_common_errors {
  75     my ($param) = @_;
  76     if( $param->{op} !~ /^(invite|conf_invite|accept)$/ ) {
  77         return 1; #no operation specified
  78     }
  79     if( $param->{shelfnumber} !~ /^\d+$/ ) {
  80         return 2; #invalid shelf number
  81     }
  82     if( ! C4::Context->preference('OpacAllowSharingPrivateLists') ) {
  83         return 3; #not or no longer allowed?
  84     }
  85     return;
  86 }
  87
  88 sub show_invite {
  89     my ($param) = @_;
  90     return unless check_owner_category( $param );
  91 }
  92
  93 sub confirm_invite {
  94     my ($param) = @_;
  95     return unless check_owner_category( $param );
  96     process_addrlist( $param );
  97     if( @{$param->{appr_addr}} ) {
  98         send_invitekey( $param );
  99     }
 100     else {
 101         $param->{errcode}=6; #not one valid address
 102     }
 103 }
 104
 105 sub show_accept {
 106     my ($param) = @_;
 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     });
 151 }
 152
 153 sub process_addrlist {
 154     my ($param) = @_;
 155     my @temp= split /[,:;]/, $param->{addrlist};
 156     my @appr_addr;
 157     my @fail_addr;
 158     foreach my $a (@temp) {
 159         $a=~s/^\s+//;
 160         $a=~s/\s+$//;
 161         if( IsEmailAddress($a) ) {
 162             push @appr_addr, $a;
 163         }
 164         else {
 165             push @fail_addr, $a;
 166         }
 167     }
 168     $param->{appr_addr}= \@appr_addr;
 169     $param->{fail_addr}= \@fail_addr;
 170 }
 171
 172 sub send_invitekey {
 173     my ($param) = @_;
 174     my $fromaddr= C4::Context->preference('KohaAdminEmailAddress');
 175     my $url= 'http://'.C4::Context->preference('OPACBaseURL').
 176         "/cgi-bin/koha/opac-shareshelf.pl?shelfnumber=".
 177         $param->{shelfnumber}."&op=accept&key=";
 178         #TODO Waiting for the right http or https solution (BZ 8952 a.o.)
 179
 180     my @ok; #the addresses that were processed well
 181     foreach my $a ( @{$param->{appr_addr}} ) {
 182         my @newkey= randomlist(KEYLENGTH, 64); #generate a new key
 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
 191         #prepare letter
 192         my $letter= C4::Letters::GetPreparedLetter(
 193             module => 'members',
 194             letter_code => 'SHARE_INVITE',
 195             branchcode => C4::Context->userenv->{"branch"},
 196             tables => { borrowers => $param->{loggedinuser}, },
 197             substitute => {
 198                 listname => $param->{shelfname},
 199                 shareurl => $url.keytostring(\@newkey,0),
 200             },
 201         );
 202
 203         #send letter to queue
 204         C4::Letters::EnqueueLetter( {
 205             letter                 => $letter,
 206             message_transport_type => 'email',
 207             from_address           => $fromaddr,
 208             to_address             => $a,
 209         });
 210     }
 211     $param->{appr_addr}= \@ok;
 212 }
 213
 214 sub check_owner_category {
 215     my ($param)= @_;
 216     #sharing user should be the owner
 217     #list should be private
 218     $param->{errcode}=4 if $param->{owner}!= $param->{loggedinuser};
 219     $param->{errcode}=5 if !$param->{errcode} && $param->{category}!=1;
 220     return !defined $param->{errcode};
 221 }
 222
 223 sub load_template {
 224     my ($param)= @_;
 225     ($param->{template}, $param->{loggedinuser}, $param->{cookie} ) =
 226     get_template_and_user( {
 227         template_name   => TEMPLATE_NAME,
 228         query           => $param->{query},
 229         type            => "opac",
 230         authnotrequired => 0, #should be a user
 231     } );
 232 }
 233
 234 sub load_template_vars {
 235     my ($param) = @_;
 236     my $template = $param->{template};
 237     my $appr= join '; ', @{$param->{appr_addr}};
 238     my $fail= join '; ', @{$param->{fail_addr}};
 239     $template->param(
 240         errcode         => $param->{errcode},
 241         op              => $param->{op},
 242         shelfnumber     => $param->{shelfnumber},
 243         shelfname       => $param->{shelfname},
 244         approvedaddress => $appr,
 245         failaddress     => $fail,
 246     );
 247 }
 248
 249 sub IsEmailAddress {
 250     #TODO candidate for a module?
 251     return Email::Valid->address($_[0])? 1: 0;
 252 }
 253
 254 sub randomlist {
 255 #uses rand, safe enough for this application but not for more sensitive data
 256     my ($length, $base)= @_;
 257     return map { int(rand($base)); } 1..$length;
 258 }
 259
 260 sub keytostring {
 261     my ($keyref, $flgBase64)= @_;
 262     if($flgBase64) {
 263         my $alphabet= [ 'A'..'Z', 'a'..'z', 0..9, '+', '/' ];
 264         return join '', map { alphabet_char($_, $alphabet); } @$keyref;
 265     }
 266     return join '', map { sprintf("%02d",$_); } @$keyref;
 267 }
 268
 269 sub stringtokey {
 270     my ($str, $flgBase64)= @_;
 271     my @temp=split '', $str||'';
 272     if($flgBase64) {
 273         my $alphabet= [ 'A'..'Z', 'a'..'z', 0..9, '+', '/' ];
 274         return [ map { alphabet_ordinal($_, $alphabet); } @temp ];
 275     }
 276     return [] if $str!~/^\d+$/;
 277     my @retval;
 278     for(my $i=0; $i<@temp-1; $i+=2) {
 279         push @retval, $temp[$i]*10+$temp[$i+1];
 280     }
 281     return \@retval;
 282 }
 283
 284 sub alphabet_ordinal {
 285     my ($char, $alphabet) = @_;
 286     for( 0..$#$alphabet ) {
 287         return $_ if $char eq $alphabet->[$_];
 288     }
 289     return ''; #ignore missing chars
 290 }
 291
 292 sub alphabet_char {
 293 #reverse operation for ordinal; ignore invalid numbers
 294     my ($num, $alphabet) = @_;
 295     return $num =~ /^\d+$/ && $num<=$#$alphabet? $alphabet->[$num]: '';
 296 }