"Fossies" - the Fresh Open Source Software Archive

Member "koha-19.11.15/members/setstatus.pl" (23 Feb 2021, 2608 Bytes) of package /linux/misc/koha-19.11.15.tar.gz:

As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "setstatus.pl" see the Fossies "Dox" file reference documentation and the last Fossies "Diffs" side-by-side code changes report: 20.05.06_vs_20.11.00.

    1 #!/usr/bin/perl
    2 
    3 #script to set or lift debarred status
    4 #written 2/8/04
    5 #by oleonard@athenscounty.lib.oh.us
    6 
    7 
    8 # Copyright 2000-2002 Katipo Communications
    9 # Parts copyright 2010 BibLibre
   10 #
   11 # This file is part of Koha.
   12 #
   13 # Koha is free software; you can redistribute it and/or modify it
   14 # under the terms of the GNU General Public License as published by
   15 # the Free Software Foundation; either version 3 of the License, or
   16 # (at your option) any later version.
   17 #
   18 # Koha is distributed in the hope that it will be useful, but
   19 # WITHOUT ANY WARRANTY; without even the implied warranty of
   20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
   21 # GNU General Public License for more details.
   22 #
   23 # You should have received a copy of the GNU General Public License
   24 # along with Koha; if not, see <http://www.gnu.org/licenses>.
   25 
   26 use Modern::Perl;
   27 
   28 use CGI qw ( -utf8 );
   29 use C4::Context;
   30 use C4::Members;
   31 use C4::Auth;
   32 use Koha::Patrons;
   33 
   34 
   35 my $input = new CGI;
   36 
   37 my ( $loggedinuserid ) = checkauth($input, 0, { borrowers => 'edit_borrowers' }, 'intranet');
   38 
   39 my $destination = $input->param("destination") || '';
   40 my $borrowernumber=$input->param('borrowernumber');
   41 my $status = $input->param('status');
   42 my $reregistration = $input->param('reregistration') || '';
   43 
   44 my $dbh = C4::Context->dbh;
   45 my $dateexpiry;
   46 
   47 my $logged_in_user = Koha::Patrons->find( { userid =>  $loggedinuserid } ) or die "Not logged in";
   48 my $patron         = Koha::Patrons->find( $borrowernumber );
   49 
   50 # Ideally we should display a warning on the interface if the logged in user is
   51 # not allowed to modify this patron.
   52 # But a librarian is not supposed to hack the system
   53 if ( $logged_in_user->can_see_patron_infos($patron) ) {
   54     if ( $reregistration eq 'y' ) {
   55         # re-reregistration function to automatic calcul of date expiry
   56         $dateexpiry = $patron->renew_account;
   57     } else {
   58         my $sth = $dbh->prepare("UPDATE borrowers SET debarred = ?, debarredcomment = '' WHERE borrowernumber = ?");
   59         $sth->execute( $status, $borrowernumber );
   60         $sth->finish;
   61     }
   62 }
   63 
   64 if($destination eq "circ"){
   65     if($dateexpiry){
   66         print $input->redirect("/cgi-bin/koha/circ/circulation.pl?borrowernumber=$borrowernumber&was_renewed=1");
   67     } else {
   68         print $input->redirect("/cgi-bin/koha/circ/circulation.pl?borrowernumber=$borrowernumber");
   69     }
   70 } else {
   71     if($dateexpiry){
   72         print $input->redirect("/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber&was_renewed=1");
   73     } else {
   74         print $input->redirect("/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber");
   75     }
   76 }