From 57d5b19dcaa8243138deb65ecac03859e4ac7684 Mon Sep 17 00:00:00 2001 From: tgarip1957 Date: Mon, 11 Sep 2006 17:09:59 +0000 Subject: [PATCH] Fixes bug with MARChtml2xml in Biblio.pm synching with dev_week --- C4/Auth.pm | 921 ++++++++++++++++++---------------------- C4/AuthoritiesMarc.pm | 66 ++- C4/Biblio.pm | 39 +- C4/Circulation/Date.pm | 134 ------ C4/Circulation/Fines.pm | 2 +- C4/Members.pm | 131 +++++- 6 files changed, 579 insertions(+), 714 deletions(-) delete mode 100644 C4/Circulation/Date.pm diff --git a/C4/Auth.pm b/C4/Auth.pm index 70e20a022b..a9772b436a 100644 --- a/C4/Auth.pm +++ b/C4/Auth.pm @@ -25,11 +25,9 @@ use Digest::MD5 qw(md5_base64); require Exporter; use C4::Context; -use C4::Output; # to get the template +use C4::Output; # to get the template use C4::Interface::CGI::Output; -use C4::Circulation::Circ2; # getpatroninformation -use C4::Koha; - +use C4::Members; # getpatroninformation # use Net::LDAP; # use Net::LDAP qw(:all); @@ -58,7 +56,8 @@ C4::Auth - Authenticates Koha users }); print $query->header( - -type => guesstype($template->output), + -type => "text/html", + -charset=>"utf-8", -cookie => $cookie ), $template->output; @@ -76,10 +75,12 @@ C4::Auth - Authenticates Koha users =cut -@ISA = qw(Exporter); + + +@ISA = qw(Exporter); @EXPORT = qw( - &checkauth - &get_template_and_user + &checkauth + &get_template_and_user ); =item get_template_and_user @@ -108,132 +109,128 @@ C4::Auth - Authenticates Koha users =cut -sub get_template_and_user { - my $in = shift; - my $template = - gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'} ); - my ( $user, $cookie, $sessionID, $flags ) = checkauth( - $in->{'query'}, - $in->{'authnotrequired'}, - $in->{'flagsrequired'}, - $in->{'type'} - ); - - my $borrowernumber; - if ($user) { - $template->param( loggedinusername => $user ); - $template->param( sessionID => $sessionID ); - - $borrowernumber = getborrowernumber($user); - my ( $borr, $alternativeflags ) = - getpatroninformation( undef, $borrowernumber ); - my @bordat; - $bordat[0] = $borr; - $template->param( USER_INFO => \@bordat, ); - - # We are going to use the $flags returned by checkauth - # to create the template's parameters that will indicate - # which menus the user can access. - if ( $flags && $flags->{superlibrarian} == 1 ) { - $template->param( CAN_user_circulate => 1 ); - $template->param( CAN_user_catalogue => 1 ); - $template->param( CAN_user_parameters => 1 ); - $template->param( CAN_user_borrowers => 1 ); - $template->param( CAN_user_permission => 1 ); - $template->param( CAN_user_reserveforothers => 1 ); - $template->param( CAN_user_borrow => 1 ); - $template->param( CAN_user_reserveforself => 1 ); - $template->param( CAN_user_editcatalogue => 1 ); - $template->param( CAN_user_updatecharge => 1 ); - $template->param( CAN_user_acquisition => 1 ); - $template->param( CAN_user_management => 1 ); - $template->param( CAN_user_tools => 1 ); - } - - if ( $flags && $flags->{circulate} == 1 ) { - $template->param( CAN_user_circulate => 1 ); - } - - if ( $flags && $flags->{catalogue} == 1 ) { - $template->param( CAN_user_catalogue => 1 ); - } - - if ( $flags && $flags->{parameters} == 1 ) { - $template->param( CAN_user_parameters => 1 ); - $template->param( CAN_user_management => 1 ); - $template->param( CAN_user_tools => 1 ); - } - - if ( $flags && $flags->{borrowers} == 1 ) { - $template->param( CAN_user_borrowers => 1 ); - } - - if ( $flags && $flags->{permissions} == 1 ) { - $template->param( CAN_user_permission => 1 ); - } - - if ( $flags && $flags->{reserveforothers} == 1 ) { - $template->param( CAN_user_reserveforothers => 1 ); - } - - if ( $flags && $flags->{borrow} == 1 ) { - $template->param( CAN_user_borrow => 1 ); - } - - if ( $flags && $flags->{reserveforself} == 1 ) { - $template->param( CAN_user_reserveforself => 1 ); - } - - if ( $flags && $flags->{editcatalogue} == 1 ) { - $template->param( CAN_user_editcatalogue => 1 ); - } - - if ( $flags && $flags->{updatecharges} == 1 ) { - $template->param( CAN_user_updatecharge => 1 ); - } - - if ( $flags && $flags->{acquisition} == 1 ) { - $template->param( CAN_user_acquisition => 1 ); - } - - if ( $flags && $flags->{management} == 1 ) { - $template->param( CAN_user_management => 1 ); - $template->param( CAN_user_tools => 1 ); - } - - if ( $flags && $flags->{tools} == 1 ) { - $template->param( CAN_user_tools => 1 ); - } - } - unless ( $in->{'type'} eq "intranet" ) { +sub get_template_and_user { + my $in = shift; + my $template = gettemplate($in->{'template_name'}, $in->{'type'},$in->{'query'}); + my ($user, $cookie, $sessionID, $flags) + = checkauth($in->{'query'}, $in->{'authnotrequired'}, $in->{'flagsrequired'}, $in->{'type'}); + + my $borrowernumber; + if ($user) { + $template->param(loggedinusername => $user); + $template->param(sessionID => $sessionID); + + $borrowernumber = getborrowernumber($user); + my ($borr, $alternativeflags) = getpatroninformation(undef, $borrowernumber); + my @bordat; + $bordat[0] = $borr; + $template->param(USER_INFO => \@bordat, + ); + + # We are going to use the $flags returned by checkauth + # to create the template's parameters that will indicate + # which menus the user can access. + if ($flags && $flags->{superlibrarian} == 1) + { + $template->param(CAN_user_circulate => 1); + $template->param(CAN_user_catalogue => 1); + $template->param(CAN_user_parameters => 1); + $template->param(CAN_user_borrowers => 1); + $template->param(CAN_user_permission => 1); + $template->param(CAN_user_reserveforothers => 1); + $template->param(CAN_user_borrow => 1); + $template->param(CAN_user_reserveforself => 1); + $template->param(CAN_user_editcatalogue => 1); + $template->param(CAN_user_updatecharge => 1); + $template->param(CAN_user_acquisition => 1); + $template->param(CAN_user_management => 1); + $template->param(CAN_user_tools => 1); } + + if ($flags && $flags->{circulate} == 1) { + $template->param(CAN_user_circulate => 1); } + + if ($flags && $flags->{catalogue} == 1) { + $template->param(CAN_user_catalogue => 1); } + + + if ($flags && $flags->{parameters} == 1) { + $template->param(CAN_user_parameters => 1); + $template->param(CAN_user_management => 1); + $template->param(CAN_user_tools => 1); } + + + if ($flags && $flags->{borrowers} == 1) { + $template->param(CAN_user_borrowers => 1); } + + + if ($flags && $flags->{permissions} == 1) { + $template->param(CAN_user_permission => 1); } + + if ($flags && $flags->{reserveforothers} == 1) { + $template->param(CAN_user_reserveforothers => 1); } + + + if ($flags && $flags->{borrow} == 1) { + $template->param(CAN_user_borrow => 1); } + + + if ($flags && $flags->{reserveforself} == 1) { + $template->param(CAN_user_reserveforself => 1); } + + + if ($flags && $flags->{editcatalogue} == 1) { + $template->param(CAN_user_editcatalogue => 1); } + + + if ($flags && $flags->{updatecharges} == 1) { + $template->param(CAN_user_updatecharge => 1); } + + if ($flags && $flags->{acquisition} == 1) { + $template->param(CAN_user_acquisition => 1); } + + if ($flags && $flags->{management} == 1) { + $template->param(CAN_user_management => 1); + $template->param(CAN_user_tools => 1); } + + if ($flags && $flags->{tools} == 1) { + $template->param(CAN_user_tools => 1); } + + } + if ($in->{'type'} eq "intranet") { $template->param( - suggestion => C4::Context->preference("suggestion"), - virtualshelves => C4::Context->preference("virtualshelves"), - OpacNav => C4::Context->preference("OpacNav"), - opacheader => C4::Context->preference("opacheader"), - opaccredits => C4::Context->preference("opaccredits"), - opacsmallimage => C4::Context->preference("opacsmallimage"), - opaclayoutstylesheet => - C4::Context->preference("opaclayoutstylesheet"), - opaccolorstylesheet => - C4::Context->preference("opaccolorstylesheet"), - opaclanguagesdisplay => - C4::Context->preference("opaclanguagesdisplay"), - TemplateEncoding => C4::Context->preference("TemplateEncoding"), - opacuserlogin => C4::Context->preference("opacuserlogin"), - opacbookbag => C4::Context->preference("opacbookbag"), + intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"), + intranetstylesheet => C4::Context->preference("intranetstylesheet"), + IntranetNav => C4::Context->preference("IntranetNav"), + ); - } - $template->param( - TemplateEncoding => C4::Context->preference('TemplateEncoding'), - AmazonContent => C4::Context->preference('AmazonContent'), - LibraryName => C4::Context->preference('LibraryName'), - branchname => C4::Context->userenv->{'branchname'}, - ); - return ( $template, $borrowernumber, $cookie ); + + } + else { + $template->param( + suggestion => C4::Context->preference("suggestion"), + virtualshelves => C4::Context->preference("virtualshelves"), + OpacNav => C4::Context->preference("OpacNav"), + opacheader => C4::Context->preference("opacheader"), + opaccredits => C4::Context->preference("opaccredits"), + opacsmallimage => C4::Context->preference("opacsmallimage"), + opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"), + opaccolorstylesheet => C4::Context->preference("opaccolorstylesheet"), + opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"), + TemplateEncoding => C4::Context->preference("TemplateEncoding"), + opacuserlogin => C4::Context->preference("opacuserlogin"), + opacbookbag => C4::Context->preference("opacbookbag"), + ); + } + $template->param( + TemplateEncoding => C4::Context->preference("TemplateEncoding"), + AmazonContent => C4::Context->preference("AmazonContent"), + LibraryName => C4::Context->preference("LibraryName"), + ); + return ($template, $borrowernumber, $cookie); } + =item checkauth ($userid, $cookie, $sessionID) = &checkauth($query, $noauth, $flagsrequired, $type); @@ -292,411 +289,305 @@ has authenticated. =cut -sub checkauth { - my $query = shift; -# $authnotrequired will be set for scripts which will run without authentication - my $authnotrequired = shift; - my $flagsrequired = shift; - my $type = shift; - $type = 'opac' unless $type; - - my $dbh = C4::Context->dbh; - my $timeout = C4::Context->preference('timeout'); - $timeout = 600 unless $timeout; - - my $template_name; - if ( $type eq 'opac' ) { - $template_name = "opac-auth.tmpl"; - } - else { - $template_name = "auth.tmpl"; - } - - # state variables - my $loggedin = 0; - my %info; - my ( $userid, $cookie, $sessionID, $flags, $envcookie ); - my $logout = $query->param('logout.x'); - if ( $userid = $ENV{'REMOTE_USER'} ) { - - # Using Basic Authentication, no cookies required - $cookie = $query->cookie( - -name => 'sessionID', - -value => '', - -expires => '' - ); - $loggedin = 1; - } - elsif ( $sessionID = $query->cookie('sessionID') ) { - C4::Context->_new_userenv($sessionID); - if ( my %hash = $query->cookie('userenv') ) { - C4::Context::set_userenv( - $hash{number}, $hash{id}, - $hash{cardnumber}, $hash{firstname}, - $hash{surname}, $hash{branch}, - $hash{branchname}, $hash{flags}, - $hash{emailaddress}, $hash{branchprinter} - ); - } - my ( $ip, $lasttime ); - - ( $userid, $ip, $lasttime ) = - $dbh->selectrow_array( - "SELECT userid,ip,lasttime FROM sessions WHERE sessionid=?", - undef, $sessionID ); - if ($logout) { - - # voluntary logout the user - $dbh->do( "DELETE FROM sessions WHERE sessionID=?", - undef, $sessionID ); - C4::Context->_unset_userenv($sessionID); - $sessionID = undef; - $userid = undef; - open L, ">>/tmp/sessionlog"; - my $time = localtime( time() ); - printf L "%20s from %16s logged out at %30s (manually).\n", $userid, - $ip, $time; - close L; - } - if ($userid) { - if ( $lasttime < time() - $timeout ) { - - # timed logout - $info{'timed_out'} = 1; - $dbh->do( "DELETE FROM sessions WHERE sessionID=?", - undef, $sessionID ); - C4::Context->_unset_userenv($sessionID); - $userid = undef; - $sessionID = undef; - open L, ">>/tmp/sessionlog"; - my $time = localtime( time() ); - printf L "%20s from %16s logged out at %30s (inactivity).\n", - $userid, $ip, $time; - close L; - } - elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) { - - # Different ip than originally logged in from - $info{'oldip'} = $ip; - $info{'newip'} = $ENV{'REMOTE_ADDR'}; - $info{'different_ip'} = 1; - $dbh->do( "DELETE FROM sessions WHERE sessionID=?", - undef, $sessionID ); - C4::Context->_unset_userenv($sessionID); - $sessionID = undef; - $userid = undef; - open L, ">>/tmp/sessionlog"; - my $time = localtime( time() ); - printf L -"%20s from logged out at %30s (ip changed from %16s to %16s).\n", - $userid, $time, $ip, $info{'newip'}; - close L; - } - else { - $cookie = $query->cookie( - -name => 'sessionID', - -value => $sessionID, - -expires => '' - ); - $dbh->do( "UPDATE sessions SET lasttime=? WHERE sessionID=?", - undef, ( time(), $sessionID ) ); - $flags = haspermission( $dbh, $userid, $flagsrequired ); - if ($flags) { - $loggedin = 1; - } - else { - $info{'nopermission'} = 1; - } - } - } - } - unless ($userid) { - $sessionID = int( rand() * 100000 ) . '-' . time(); - $userid = $query->param('userid'); - C4::Context->_new_userenv($sessionID); - my $password = $query->param('password'); - C4::Context->_new_userenv($sessionID); - my ( $return, $cardnumber ) = checkpw( $dbh, $userid, $password ); - if ($return) { - $dbh->do( "DELETE FROM sessions WHERE sessionID=? AND userid=?", - undef, ( $sessionID, $userid ) ); - $dbh->do( -"INSERT INTO sessions (sessionID, userid, ip,lasttime) VALUES (?, ?, ?, ?)", - undef, - ( $sessionID, $userid, $ENV{'REMOTE_ADDR'}, time() ) - ); - open L, ">>/tmp/sessionlog"; - my $time = localtime( time() ); - printf L "%20s from %16s logged in at %30s.\n", $userid, - $ENV{'REMOTE_ADDR'}, $time; - close L; - $cookie = $query->cookie( - -name => 'sessionID', - -value => $sessionID, - -expires => '' - ); - if ( $flags = haspermission( $dbh, $userid, $flagsrequired ) ) { - $loggedin = 1; - } - else { - $info{'nopermission'} = 1; - C4::Context->_unset_userenv($sessionID); - } - if ( $return == 1 ) { - my ( $bornum, $firstname, $surname, $userflags, $branchcode, - $branchname, $branchprinter, $emailaddress ); - my $sth = - $dbh->prepare( -"select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname,branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?" - ); - $sth->execute($userid); - ( - $bornum, $firstname, $surname, $userflags, $branchcode, - $branchname, $branchprinter, $emailaddress - ) - = $sth->fetchrow - if ( $sth->rows ); +sub checkauth { + my $query=shift; + # $authnotrequired will be set for scripts which will run without authentication + my $authnotrequired = shift; + my $flagsrequired = shift; + my $type = shift; + $type = 'opac' unless $type; + + my $dbh = C4::Context->dbh; + my $timeout = C4::Context->preference('timeout'); + $timeout = 600 unless $timeout; + + my $template_name; + if ($type eq 'opac') { + $template_name = "opac-auth.tmpl"; + } else { + $template_name = "auth.tmpl"; + } + + # state variables + my $loggedin = 0; + my %info; + my ($userid, $cookie, $sessionID, $flags,$envcookie); + my $logout = $query->param('logout.x'); + if ($userid = $ENV{'REMOTE_USER'}) { + # Using Basic Authentication, no cookies required + $cookie=$query->cookie(-name => 'sessionID', + -value => '', + -expires => ''); + $loggedin = 1; + } elsif ($sessionID=$query->cookie('sessionID')) { + C4::Context->_new_userenv($sessionID); + if (my %hash=$query->cookie('userenv')){ + C4::Context::set_userenv( + $hash{number}, + $hash{id}, + $hash{cardnumber}, + $hash{firstname}, + $hash{surname}, + $hash{branch}, + $hash{branchname}, + $hash{flags}, + $hash{emailaddress}, + ); + } + my ($ip , $lasttime); + + ($userid, $ip, $lasttime) = $dbh->selectrow_array( + "SELECT userid,ip,lasttime FROM sessions WHERE sessionid=?", + undef, $sessionID); + if ($logout) { + # voluntary logout the user + $dbh->do("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID); + C4::Context->_unset_userenv($sessionID); + $sessionID = undef; + $userid = undef; + open L, ">>/tmp/sessionlog"; + my $time=localtime(time()); + printf L "%20s from %16s logged out at %30s (manually).\n", $userid, $ip, $time; + close L; + } + if ($userid) { + if ($lasttimedo("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID); + C4::Context->_unset_userenv($sessionID); + $userid = undef; + $sessionID = undef; + open L, ">>/tmp/sessionlog"; + my $time=localtime(time()); + printf L "%20s from %16s logged out at %30s (inactivity).\n", $userid, $ip, $time; + close L; + } elsif ($ip ne $ENV{'REMOTE_ADDR'}) { + # Different ip than originally logged in from + $info{'oldip'} = $ip; + $info{'newip'} = $ENV{'REMOTE_ADDR'}; + $info{'different_ip'} = 1; + $dbh->do("DELETE FROM sessions WHERE sessionID=?", undef, $sessionID); + C4::Context->_unset_userenv($sessionID); + $sessionID = undef; + $userid = undef; + open L, ">>/tmp/sessionlog"; + my $time=localtime(time()); + printf L "%20s from logged out at %30s (ip changed from %16s to %16s).\n", $userid, $time, $ip, $info{'newip'}; + close L; + } else { + $cookie=$query->cookie(-name => 'sessionID', + -value => $sessionID, + -expires => ''); + $dbh->do("UPDATE sessions SET lasttime=? WHERE sessionID=?", + undef, (time(), $sessionID)); + $flags = haspermission($dbh, $userid, $flagsrequired); + if ($flags) { + $loggedin = 1; + } else { + $info{'nopermission'} = 1; + } + } + } + } + unless ($userid) { + $sessionID=int(rand()*100000).'-'.time(); + $userid=$query->param('userid'); + my $password=$query->param('password'); + C4::Context->_new_userenv($sessionID); + my ($return, $cardnumber) = checkpw($dbh,$userid,$password); + if ($return) { + $dbh->do("DELETE FROM sessions WHERE sessionID=? AND userid=?", + undef, ($sessionID, $userid)); + $dbh->do("INSERT INTO sessions (sessionID, userid, ip,lasttime) VALUES (?, ?, ?, ?)", + undef, ($sessionID, $userid, $ENV{'REMOTE_ADDR'}, time())); + open L, ">>/tmp/sessionlog"; + my $time=localtime(time()); + printf L "%20s from %16s logged in at %30s.\n", $userid, $ENV{'REMOTE_ADDR'}, $time; + close L; + $cookie=$query->cookie(-name => 'sessionID', + -value => $sessionID, + -expires => ''); + if ($flags = haspermission($dbh, $userid, $flagsrequired)) { + $loggedin = 1; + } else { + $info{'nopermission'} = 1; + C4::Context->_unset_userenv($sessionID); + } + if ($return == 1){ + my ($bornum,$firstname,$surname,$userflags,$branchcode,$branchname,$emailaddress); + my $sth=$dbh->prepare("select borrowernumber,firstname,surname,flags,borrowers.branchcode,branchname,emailaddress from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?"); + $sth->execute($userid); + ($bornum,$firstname,$surname,$userflags,$branchcode,$branchname, $emailaddress) = $sth->fetchrow if ($sth->rows); # warn "$cardnumber,$bornum,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress"; - unless ( $sth->rows ) { - my $sth = - $dbh->prepare( -"select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname, branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?" - ); - $sth->execute($cardnumber); - ( - $bornum, $firstname, $surname, $userflags, $branchcode, - $branchcode, $branchprinter, $emailaddress - ) - = $sth->fetchrow - if ( $sth->rows ); - + unless ($sth->rows){ + my $sth=$dbh->prepare("select borrowernumber,firstname,surname,flags,borrowers.branchcode,branchname,emailaddress from borrowers left join branches on borrowers.branchcode=branches.branchcode where cardnumber=?"); + $sth->execute($cardnumber); + ($bornum,$firstname,$surname,$userflags,$branchcode, $branchname,$emailaddress) = $sth->fetchrow if ($sth->rows); # warn "$cardnumber,$bornum,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress"; - unless ( $sth->rows ) { - $sth->execute($userid); - ( - $bornum, $firstname, $surname, $userflags, - $branchcode, $branchprinter, $emailaddress - ) - = $sth->fetchrow - if ( $sth->rows ); - } - + unless ($sth->rows){ + $sth->execute($userid); + ($bornum,$firstname,$surname,$userflags,$branchcode, $branchname, $emailaddress) = $sth->fetchrow if ($sth->rows); + } # warn "$cardnumber,$bornum,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress"; - } - -# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # -# new op dev : -# launch a sequence to check if we have a ip for the branch, if we have one we replace the branchcode of the userenv by the branch bound in the ip. - my $ip = $ENV{'REMOTE_ADDR'}; - my $branches = GetBranches('IS'); - my @branchesloop; - my $branchprinter; - foreach my $br ( keys %$branches ) { - - # now we work with the treatment of ip - my $domain = $branches->{$br}->{branchip}; - if ( $domain && $ip =~ /^$domain/ ) { - $branchcode = $branches->{$br}->{'branchcode'}; - - # new op dev : add the branchprinter and branchname in the cookie - $branchprinter = $branches->{$br}->{'branchprinter'}; - $branchname = $branches->{$br}->{'branchname'}; - } - } - - my $hash = C4::Context::set_userenv( - $bornum, $userid, $cardnumber, - $firstname, $surname, $branchcode, - $branchname, $userflags, $emailaddress, - $branchprinter, - ); - - $envcookie = $query->cookie( - -name => 'userenv', - -value => $hash, - -expires => '' - ); - } - elsif ( $return == 2 ) { - - #We suppose the user is the superlibrarian - my $hash = C4::Context::set_userenv( - 0, - 0, - C4::Context->config('user'), - C4::Context->config('user'), - C4::Context->config('user'), - "", - 1, - C4::Context->preference('KohaAdminEmailAddress') - ); - $envcookie = $query->cookie( - -name => 'userenv', - -value => $hash, - -expires => '' - ); - } - } - else { - if ($userid) { - $info{'invalid_username_or_password'} = 1; - C4::Context->_unset_userenv($sessionID); - } - } - } - my $insecure = C4::Context->boolean_preference('insecure'); - - # finished authentification, now respond - if ( $loggedin || $authnotrequired || ( defined($insecure) && $insecure ) ) - { - - # successful login - unless ($cookie) { - $cookie = $query->cookie( - -name => 'sessionID', - -value => '', - -expires => '' - ); - } - if ($envcookie) { - return ( $userid, [ $cookie, $envcookie ], $sessionID, $flags ); - } - else { - return ( $userid, $cookie, $sessionID, $flags ); - } - } - - # else we have a problem... - # get the inputs from the incoming query - my @inputs = (); - foreach my $name ( param $query) { - (next) if ( $name eq 'userid' || $name eq 'password' ); - my $value = $query->param($name); - push @inputs, { name => $name, value => $value }; - } - - my $template = gettemplate( $template_name, $type, $query ); - $template->param( - INPUTS => \@inputs, - intranetcolorstylesheet => - C4::Context->preference("intranetcolorstylesheet"), - intranetstylesheet => C4::Context->preference("intranetstylesheet"), - IntranetNav => C4::Context->preference("IntranetNav"), - TemplateEncoding => C4::Context->preference("TemplateEncoding"), - - ); - $template->param( loginprompt => 1 ) unless $info{'nopermission'}; - - my $self_url = $query->url( -absolute => 1 ); - $template->param( - url => $self_url, - LibraryName => => C4::Context->preference("LibraryName"), - ); - $template->param( \%info ); - $cookie = $query->cookie( - -name => 'sessionID', - -value => $sessionID, - -expires => '' - ); - print $query->header( - -type => guesstype( $template->output ), - -cookie => $cookie - ), - $template->output; - exit; + } + my $hash = C4::Context::set_userenv( + $bornum, + $userid, + $cardnumber, + $firstname, + $surname, + $branchcode, + $branchname, + $userflags, + $emailaddress, + ); +# warn "$cardnumber,$bornum,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress"; + $envcookie=$query->cookie(-name => 'userenv', + -value => $hash, + -expires => ''); + } elsif ($return == 2) { + #We suppose the user is the superlibrarian + my $hash = C4::Context::set_userenv( + 0,0, + C4::Context->config('user'), + C4::Context->config('user'), + C4::Context->config('user'), + "","",1,C4::Context->preference('KohaAdminEmailAddress') + ); + $envcookie=$query->cookie(-name => 'userenv', + -value => $hash, + -expires => ''); + } + } else { + if ($userid) { + $info{'invalid_username_or_password'} = 1; + C4::Context->_unset_userenv($sessionID); + } + } + } + my $insecure = C4::Context->boolean_preference('insecure'); + # finished authentification, now respond + if ($loggedin || $authnotrequired || (defined($insecure) && $insecure)) { + # successful login + unless ($cookie) { + $cookie=$query->cookie(-name => 'sessionID', + -value => '', + -expires => ''); + } + if ($envcookie){ + return ($userid, [$cookie,$envcookie], $sessionID, $flags) + } else { + return ($userid, $cookie, $sessionID, $flags); + } + } + # else we have a problem... + # get the inputs from the incoming query + my @inputs =(); + foreach my $name (param $query) { + (next) if ($name eq 'userid' || $name eq 'password'); + my $value = $query->param($name); + push @inputs, {name => $name , value => $value}; + } + + my $template = gettemplate($template_name, $type,$query); + $template->param(INPUTS => \@inputs, + intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"), + intranetstylesheet => C4::Context->preference("intranetstylesheet"), + IntranetNav => C4::Context->preference("IntranetNav"), + opacnav => C4::Context->preference("OpacNav"), + TemplateEncoding => C4::Context->preference("TemplateEncoding"), + + ); + $template->param(loginprompt => 1) unless $info{'nopermission'}; + + my $self_url = $query->url(-absolute => 1); + $template->param(url => $self_url, LibraryName=> => C4::Context->preference("LibraryName"),); + $template->param(\%info); + $cookie=$query->cookie(-name => 'sessionID', + -value => $sessionID, + -expires => ''); + print $query->header( + -type => "text/html", + -charset=>"utf-8", + -cookie => $cookie + ), $template->output; + exit; } -sub checkpw { - my ( $dbh, $userid, $password ) = @_; - # INTERNAL AUTH - my $sth = - $dbh->prepare("select password,cardnumber from borrowers where userid=?"); - $sth->execute($userid); - if ( $sth->rows ) { - my ( $md5password, $cardnumber ) = $sth->fetchrow; - if ( md5_base64($password) eq $md5password ) { -# C4::Context->set_userenv("$bornum",$userid,$cardnumber,$firstname,$surname,$branchcode,$userflags); - return 1, $cardnumber; - } - } - $sth = $dbh->prepare("select password from borrowers where cardnumber=?"); - $sth->execute($userid); - if ( $sth->rows ) { - my ($md5password) = $sth->fetchrow; - if ( md5_base64($password) eq $md5password ) { - -# C4::Context->set_userenv($bornum,$userid,$cardnumber,$firstname,$surname,$branchcode,$userflags); - return 1, $userid; - } - } - if ( $userid eq C4::Context->config('user') - && $password eq C4::Context->config('pass') ) - { +sub checkpw { -# Koha superuser account -# C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1); - return 2; - } - if ( $userid eq 'demo' - && $password eq 'demo' - && C4::Context->config('demo') ) - { - -# DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf -# some features won't be effective : modify systempref, modify MARC structure, - return 2; - } - return 0; + my ($dbh, $userid, $password) = @_; +# INTERNAL AUTH + my $sth=$dbh->prepare("select password,cardnumber from borrowers where userid=?"); + $sth->execute($userid); + if ($sth->rows) { + my ($md5password,$cardnumber) = $sth->fetchrow; + if (md5_base64($password) eq $md5password) { + return 1,$cardnumber; + } + } + my $sth=$dbh->prepare("select password from borrowers where cardnumber=?"); + $sth->execute($userid); + if ($sth->rows) { + my ($md5password) = $sth->fetchrow; + if (md5_base64($password) eq $md5password) { + return 1,$userid; + } + } + if ($userid eq C4::Context->config('user') && $password eq C4::Context->config('pass')) { + # Koha superuser account + return 2; + } + if ($userid eq 'demo' && $password eq 'demo' && C4::Context->config('demo')) { + # DEMO => the demo user is allowed to do everything (if demo set to 1 in koha.conf + # some features won't be effective : modify systempref, modify MARC structure, + return 2; + } + return 0; } sub getuserflags { - my $cardnumber = shift; - my $dbh = shift; + my $cardnumber=shift; + my $dbh=shift; my $userflags; - my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE cardnumber=?"); + my $sth=$dbh->prepare("SELECT flags FROM borrowers WHERE cardnumber=?"); $sth->execute($cardnumber); my ($flags) = $sth->fetchrow; - $flags = 0 unless $flags; - $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags"); + $sth=$dbh->prepare("SELECT bit, flag, defaulton FROM userflags"); $sth->execute; - - while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) { - if ( ( $flags & ( 2**$bit ) ) || $defaulton ) { - $userflags->{$flag} = 1; - } - else { - $userflags->{$flag} = 0; - } + while (my ($bit, $flag, $defaulton) = $sth->fetchrow) { + if (($flags & (2**$bit)) || $defaulton) { + $userflags->{$flag}=1; + } } return $userflags; } sub haspermission { - my ( $dbh, $userid, $flagsrequired ) = @_; - my $sth = $dbh->prepare("SELECT cardnumber FROM borrowers WHERE userid=?"); + my ($dbh, $userid, $flagsrequired) = @_; + my $sth=$dbh->prepare("SELECT cardnumber FROM borrowers WHERE userid=?"); $sth->execute($userid); my ($cardnumber) = $sth->fetchrow; - ($cardnumber) || ( $cardnumber = $userid ); - my $flags = getuserflags( $cardnumber, $dbh ); + ($cardnumber) || ($cardnumber=$userid); + my $flags=getuserflags($cardnumber,$dbh); my $configfile; - if ( $userid eq C4::Context->config('user') ) { - - # Super User Account from /etc/koha.conf - $flags->{'superlibrarian'} = 1; - } - if ( $userid eq 'demo' && C4::Context->config('demo') ) { - - # Demo user that can do "anything" (demo=1 in /etc/koha.conf) - $flags->{'superlibrarian'} = 1; + if ($userid eq C4::Context->config('user')) { + # Super User Account from /etc/koha.conf + $flags->{'superlibrarian'}=1; + } + if ($userid eq 'demo' && C4::Context->config('demo')) { + # Demo user that can do "anything" (demo=1 in /etc/koha.conf) + $flags->{'superlibrarian'}=1; } return $flags if $flags->{superlibrarian}; - foreach ( keys %$flagsrequired ) { - return $flags if $flags->{$_}; + foreach (keys %$flagsrequired) { + return $flags if $flags->{$_}; } return 0; } @@ -704,19 +595,19 @@ sub haspermission { sub getborrowernumber { my ($userid) = @_; my $dbh = C4::Context->dbh; - for my $field ( 'userid', 'cardnumber' ) { - my $sth = - $dbh->prepare("select borrowernumber from borrowers where $field=?"); - $sth->execute($userid); - if ( $sth->rows ) { - my ($bnumber) = $sth->fetchrow; - return $bnumber; - } + for my $field ('userid', 'cardnumber') { + my $sth=$dbh->prepare + ("select borrowernumber from borrowers where $field=?"); + $sth->execute($userid); + if ($sth->rows) { + my ($bnumber) = $sth->fetchrow; + return $bnumber; + } } return 0; } -END { } # module clean-up code here (global destructor) +END { } # module clean-up code here (global destructor) 1; __END__ diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index 644fb3acb7..4802319cee 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -167,8 +167,8 @@ my @linkid=XML_readline_asarray($authrecord,"auth_linkid","authorities");##May h foreach my $linkid (@linkid){ my $linktype=AUTHfind_authtypecode($dbh,$linkid); -# my $linkrecord=XMLgetauthorityhash($dbh,$linkid); -# $linksummary.="
    ".getsummary($dbh,$linkrecord,$linkid,$linktype).".".$separator; + my $linkrecord=XMLgetauthorityhash($dbh,$linkid); + $linksummary.="
    ".getsummary($dbh,$linkrecord,$linkid,$linktype).".".$separator; } my $summary; @@ -322,7 +322,7 @@ sub AUTHaddauthority { XML_writeline($record,"auth_authid",$authid,"authorities"); XML_writeline($record,"auth_authtypecode",$authtypecode,"authorities"); my $xml=XML_hash2xml($record); - my $sth=$dbh->prepare("REPLACE auth_header set marcxml=? authid=?,authtypecode=?,datecreated=now()"); + my $sth=$dbh->prepare("REPLACE auth_header set marcxml=?, authid=?,authtypecode=?,datecreated=now()"); $sth->execute($xml,$authid,$authtypecode); $sth->finish; @@ -387,10 +387,10 @@ sub AUTHgetauth_type { sub AUTHmodauthority { ## $record is expected to be an xmlhash my ($dbh,$authid,$record,$authtypecode)=@_; - my ($oldrecord)=&AUTHgetauthorityhash($dbh,$authid); + my ($oldrecord)=&XMLgetauthorityhash($dbh,$authid); ### This equality is very dodgy ,It porobaby wont work if ($oldrecord eq $record) { - return; + return $authid; } ## my $sth=$dbh->prepare("update auth_header set marcxml=? where authid=?"); @@ -399,7 +399,7 @@ my @linkids=XML_readline_asarray($oldrecord,"auth_linkid","authorities"); foreach my $linkid (@linkids){ ##Modify the record of linked - my $linkrecord=AUTHgetauthorityhash($dbh,$linkid); + my $linkrecord=XMLgetauthorityhash($dbh,$linkid); my $linktypecode=AUTHfind_authtypecode($dbh,$linkid); my @linkfields=XML_readline_asarray($linkrecord,"auth_linkid","authorities"); my $updated; @@ -607,30 +607,28 @@ my ($dbh,$record,$authid,$authtypecode)=@_; return $summary; } sub getdictsummary{ -## give this a Marc record to return summary +## give this a XML record to return a brief summary my ($dbh,$record,$authid,$authtypecode)=@_; my $authref = getauthtype($authtypecode); my $summary = $authref->{summary}; - my @fields = $record->fields(); -# chop $tags_using_authtype; + my $fields = $record->{'datafield'}; # if the library has a summary defined, use it. Otherwise, build a standard one - if ($summary) { - my @fields = $record->fields(); - foreach my $field (@fields) { - my $tag = $field->tag(); - my $tagvalue = $field->as_string(); - $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g; + if ($summary) { + foreach my $field (@$fields) { + my $tag = $field->{'tag'}; if ($tag<10) { + my $tagvalue = XML_readline_onerecord($record,"","",$field->{tag}); + $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g; } else { - my @subf = $field->subfields; + my @subf = XML_readline_withtags($record,"","",$tag); for my $i (0..$#subf) { my $subfieldcode = $subf[$i][0]; my $subfieldvalue = $subf[$i][1]; my $tagsubf = $tag.$subfieldcode; $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g; - }#for $i + }## each subf }#tag >10 - }## each field + }##each field $summary =~ s/\[(.*?)]//g; $summary =~ s/\n/
/g; } else { @@ -641,27 +639,16 @@ my ($dbh,$record,$authid,$authtypecode)=@_; my @fields = $record->{datafields}; if (C4::Context->preference('marcflavour') eq 'UNIMARC') { # construct UNIMARC summary, that is quite different from MARC21 one + foreach my $field (@$fields) { # accepted form - foreach my $field ($record->field('2..')) { - $heading.= $field->as_string(); - } - # rejected form(s) - foreach my $field ($record->field('4..')) { - $summary.= "   ".$field->as_string()."
"; - $summary.= "      see: ".$heading."
"; - } - # see : - foreach my $field ($record->field('5..')) { - $summary.= "   ".$field->as_string()."
"; - $summary.= "      see: ".$heading."
"; - } - # // form - foreach my $field ($record->field('7..')) { - $seeheading.= "      see also: ".$field->as_string()."
"; - $altheading.= "   ".$field->as_string()."
"; - $altheading.= "      see also: ".$heading."
"; - } - $summary = "".$heading."
".$seeheading.$altheading.$summary; + if ($field->{tag} = ~/'2..'/) { + foreach my $subfield ("a".."z"){ + ## Fixme-- if UNICODE uses numeric subfields as well add them + $heading.=XML_readline_onerecord($record,"","",$field->{tag},$subfield); + } + }##tag 2.. + } + $summary = $heading; } else { # construct MARC21 summary foreach my $field (@fields) { @@ -863,7 +850,7 @@ Paul POULAIN paul.poulain@free.fr =cut # $Id$ -# $Log$ + # Revision 1.30 2006/09/06 16:21:03 tgarip1957 # Clean up before final commits # @@ -916,3 +903,4 @@ Paul POULAIN paul.poulain@free.fr # Revision 1.1 2004/06/07 07:35:01 tipaul # MARC authority management package # +>>>>>>> 1.30 diff --git a/C4/Biblio.pm b/C4/Biblio.pm index f8a8599ddf..17d79f3cf1 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -282,7 +282,7 @@ my $updated=0; } }## created now }else{ - foreach my $control(@$controlfield){ + foreach my $control (@$controlfield){ if ($control->{'tag'} eq $tag){ $control->{'content'}=$newvalue; $updated=1; @@ -621,7 +621,7 @@ sub MARCgettagslib { $sth->execute($frameworkcode); my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable ); - while ( my ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) { + while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) { $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac; $res->{$tab}->{tab} = ""; # XXX $res->{$tag}->{mandatory} = $mandatory; @@ -767,9 +767,8 @@ sub MARCfind_itemtype { sub MARChtml2xml { # warn "MARChtml2xml "; - my ($tags,$subfields,$values,$indicator,$ind_tag) = @_; -# use MARC::File::XML; - my $xml= marc_record_header('UTF-8'); #### we do not need a collection wrapper + my ($tags,$subfields,$values,$indicator,$ind_tag,$tagindex) = @_; + my $xml= ""; my $prevvalue; my $prevtag=-1; @@ -782,8 +781,8 @@ sub MARChtml2xml { @$values[$i] =~ s/"/"/g; @$values[$i] =~ s/'/'/g; - if ((@$tags[$i] ne $prevtag)){ - my $tag=substr(@$tags[$i],0,3); + if ((@$tags[$i].@$tagindex[$i] ne $prevtag)){ + my $tag=@$tags[$i]; $j++ unless ($tag eq ""); ## warn "IND:".substr(@$indicator[$j],0,1).substr(@$indicator[$j],1,1)." ".@$tags[$i]; if (!$first){ @@ -820,7 +819,7 @@ sub MARChtml2xml { } } else { # @$tags[$i] eq $prevtag unless (@$values[$i] eq "") { - my $tag=substr(@$tags[$i],0,3); + my $tag=@$tags[$i]; if ($first){ my $ind1 = substr(@$indicator[$j],0,1); my $ind2 = substr(@$indicator[$j],1,1); @@ -830,7 +829,7 @@ sub MARChtml2xml { $xml.="@$values[$i]\n"; } } - $prevtag = @$tags[$i]; + $prevtag = @$tags[$i].@$tagindex[$i]; } $xml.=""; # warn $xml; @@ -968,7 +967,6 @@ my $barcode=XML_readline_onerecord($xmlhash,"barcode","holdings"); my $itemcallnumber=XML_readline_onerecord($xmlhash,"itemcallnumber","holdings"); if ($itemcallnumber){ my ($cutterextra)=itemcalculator($dbh,$biblionumber,$itemcallnumber); -warn $cutterextra; $xmlhash=XML_writeline($xmlhash,"cutterextra",$cutterextra,"holdings"); } @@ -987,7 +985,7 @@ my $sth=$dbh->prepare("SELECT biblionumber from items where itemnumber=?"); $sth->execute($itemnumber); my $biblionumber=$sth->fetchrow; OLDdelitem( $dbh, $itemnumber ) ; -ZEBRAop($dbh,$biblionumber,"recordDelete","biblioserver"); +ZEBRAop($dbh,$biblionumber,"specialUpdate","biblioserver"); } @@ -1132,7 +1130,6 @@ my $title=XML_readline_onerecord($xmlhash,"title","biblios"); my $author=XML_readline_onerecord($xmlhash,"author","biblios"); my $xml=XML_hash2xml($xmlhash); -#my $marc=MARC::Record->new_from_xml($xml,'UTF-8');## this will be depreceated $isbn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g; $issn=~ s/(\.|\?|\;|\=|\-|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)//g; $isbn=~s/^\s+|\s+$//g; @@ -1214,14 +1211,14 @@ $sth->execute($biblionumber,$server,$op); sub ZEBRAopserver{ ###Accepts a $server variable thus we can use it to update biblios, authorities or other zebra dbs -my ($record,$op,$server)=@_; +my ($record,$op,$server,$biblionumber)=@_; my @Zconnbiblio; my @port; my $Zpackage; my $tried=0; my $recon=0; my $reconnect=0; -$record=Encode::encode("utf8",$record); +$record=Encode::encode("UTF-8",$record); my $shadow=$server."shadow"; reconnect: @@ -1230,6 +1227,7 @@ if ($record){ my $Zpackage = $Zconnbiblio[0]->package(); $Zpackage->option(action => $op); $Zpackage->option(record => $record); + $Zpackage->option(recordIdOpaque => $biblionumber); retry: $Zpackage->send("update"); my $i; @@ -1290,16 +1288,15 @@ my ($dbh,$biblionumber)=@_; my $biblioxml=XMLgetbiblio($dbh,$biblionumber); my @itemxml=XMLgetallitems($dbh,$biblionumber); my $zebraxml=collection_header(); -$zebraxml.="\n"; +$zebraxml.=""; $zebraxml.=$biblioxml; -$zebraxml.="\n"; +$zebraxml.=""; foreach my $item(@itemxml){ - $zebraxml.=$item; + $zebraxml.=$item if $item; } -$zebraxml.="\n"; -$zebraxml.="\n"; -$zebraxml.="\n"; - +$zebraxml.=""; +$zebraxml.=""; +$zebraxml.=""; return $zebraxml; } diff --git a/C4/Circulation/Date.pm b/C4/Circulation/Date.pm deleted file mode 100644 index a3ceb85d8c..0000000000 --- a/C4/Circulation/Date.pm +++ /dev/null @@ -1,134 +0,0 @@ -#!/usr/bin/perl -w - -package C4::Circulation::Date; - -# $id: - -# Copyright 2005 Katipo Communications -# -# This file is part of Koha. -# -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. -# -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA - -use strict; -use C4::Context; - -require Exporter; - -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); - -$VERSION = do { my @v = '$Revision$' =~ /\d+/g; - shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); -}; - -@ISA = qw(Exporter); - -@EXPORT = qw( - &display_date_format - &format_date - &format_date_in_iso -); - -=head1 DESCRIPTION - -C4::Circulation::Date provides routines for format dates to display in human readable forms. - -=head1 FUNCTIONS - -=over 2 - -=cut - -=head2 get_date_format - - $dateformat = get_date_format(); - -Takes no input, and returns the format that the library prefers dates displayed in - - -=cut - -sub get_date_format { - - # Get the database handle - my $dbh = C4::Context->dbh; - return C4::Context->preference('dateformat'); -} - -=head2 display_date_format - - $displaydateformat = display_date_format(); - -Takes no input, and returns a string showing the format the library likes dates displayed in - - -=cut - -sub display_date_format { - my $dateformat = get_date_format(); - - if ( $dateformat eq "us" ) { - return "mm/dd/yyyy"; - } - elsif ( $dateformat eq "metric" ) { - return "dd/mm/yyyy"; - } - elsif ( $dateformat eq "iso" ) { - return "yyyy-mm-dd"; - } - else { - return -"Invalid date format: $dateformat. Please change in system preferences"; - } -} - -=head2 format_date - - $formatteddate = format_date($date); - -Takes a date, from mysql and returns it in the format specified by the library -This is less flexible than C4::Date::format_date, which can handle dates of many formats -if you need that flexibility use C4::Date, if you are just using it to format the output from mysql as -in circulation.pl use this one, it is much faster. -=cut - - -sub format_date { - my $olddate = shift; - my $newdate; - - if ( !$olddate ) { - return ""; - } - - my $dateformat = get_date_format(); - - if ( $dateformat eq "us" ) { - my @datearray=split('-',$olddate); - $newdate = "$datearray[1]/$datearray[2]/$datearray[0]"; - } - elsif ( $dateformat eq "metric" ) { - my @datearray=split('-',$olddate); - $newdate = "$datearray[2]/$datearray[1]/$datearray[0]"; - } - elsif ( $dateformat eq "iso" ) { - $newdate = $olddate; - } - else { - return -"Invalid date format: $dateformat. Please change in system preferences"; - } -} - -1; diff --git a/C4/Circulation/Fines.pm b/C4/Circulation/Fines.pm index abb89295f0..0415f3d466 100644 --- a/C4/Circulation/Fines.pm +++ b/C4/Circulation/Fines.pm @@ -1,4 +1,4 @@ -package C4::Circulation::Fines2; +package C4::Circulation::Fines; # $Id$ diff --git a/C4/Members.pm b/C4/Members.pm index e7128d8207..74852abed7 100644 --- a/C4/Members.pm +++ b/C4/Members.pm @@ -381,9 +381,7 @@ C<$issues>. =cut #' sub borrissues { - my ($bornum)=@_; -warn $bornum; my $dbh = C4::Context->dbh; my $sth=$dbh->prepare("Select * from issues,biblio,items where borrowernumber=? and items.itemnumber=issues.itemnumber @@ -981,7 +979,7 @@ sub fixupneu_cardnumber{ my $dbh = C4::Context->dbh; my $sth; if (! $cardnumber && $autonumber_members && $categorycode) { - if ($categorycode eq "A" || $categorycode eq "W" || $categorycode eq "C"){ + if ($categorycode eq "A" || $categorycode eq "W" ){ $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '5%' "); }elsif ($categorycode eq "L"){ $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '10%' "); @@ -989,6 +987,9 @@ my $sth; $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '30%' "); }elsif ($categorycode eq "N"){ $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '40%' "); + }elsif ($categorycode eq "C"){ + $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '80%' "); + }else{ $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '6%' "); } @@ -1004,9 +1005,10 @@ my $sth; # determine the 1st and 9th digits and return the full string. if (! $cardnumber) { # If DB has no values, - if ($categorycode eq "A" || $categorycode eq "W" || $categorycode eq "C"){ $cardnumber = 5000000;} + if ($categorycode eq "A" || $categorycode eq "W" ){ $cardnumber = 5000000;} elsif ($categorycode eq "L"){ $cardnumber = 1000000;} elsif ($categorycode eq "F"){ $cardnumber = 3000000;} + elsif ($categorycode eq "C"){ $cardnumber = 8000000;} else{$cardnumber = 6000000;} # start at 1000000 or 3000000 or 5000000 } else { @@ -1209,6 +1211,127 @@ sub change_user_pass { $sth->execute($uid, $digest, $member); return 1; } +=head2 checkuniquemember (OUEST-PROVENCE) + + $result = &checkuniquemember($collectivity,$surname,$categorycode,$firstname,$dateofbirth); + +Checks that a member exists or not in the database. + +C<&result> is 1 (=exist) or 0 (=does not exist) +C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member) +C<&surname> is the surname +C<&categorycode> is from categorycode table +C<&firstname> is the firstname (only if collectivity=0) +C<&dateofbirth> is the date of birth (only if collectivity=0) + +=cut + +sub checkuniquemember { + my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_; + my $dbh = C4::Context->dbh; + my $request; + if ($collectivity) { + +# $request="select count(*) from borrowers where surname=? and categorycode=?"; + $request = + "select borrowernumber,categorycode from borrowers where surname=? "; + } + else { + +# $request="select count(*) from borrowers where surname=? and categorycode=? and firstname=? and dateofbirth=?"; + $request = +"select borrowernumber,categorycode from borrowers where surname=? and firstname=? and dateofbirth=?"; + } + my $sth = $dbh->prepare($request); + if ($collectivity) { + $sth->execute( uc($surname) ); + } + else { + $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth ); + } + my @data = $sth->fetchrow; + if ( $data[0] ) { + $sth->finish; + return $data[0], $data[1]; + + # + } + else { + $sth->finish; + return 0; + } +} +=head2 getzipnamecity (OUEST-PROVENCE) + +take all info from table city for the fields city and zip +check for the name and the zip code of the city selected + +=cut + +sub getzipnamecity { + my ($cityid) = @_; + my $dbh = C4::Context->dbh; + my $sth = + $dbh->prepare( + "select city_name,city_zipcode from cities where cityid=? "); + $sth->execute($cityid); + my @data = $sth->fetchrow; + return $data[0], $data[1]; +} + +=head2 updatechildguarantor (OUEST-PROVENCE) + +check for title,firstname,surname,adress,zip code and city from guarantor to +guarantorchild + +=cut + +#' + +sub getguarantordata { + my ($borrowerid) = @_; + my $dbh = C4::Context->dbh; + my $sth = + $dbh->prepare( +"Select title,firstname,surname,streetnumber,address,streettype,address2,zipcode,city,phone,phonepro,mobile,email,emailpro,fax from borrowers where borrowernumber =? " + ); + $sth->execute($borrowerid); + my $guarantor_data = $sth->fetchrow_hashref; + $sth->finish; + return $guarantor_data; +} + +=head2 getdcity (OUEST-PROVENCE) +recover cityid with city_name condition +=cut + +sub getidcity { + my ($city_name) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("select cityid from cities where city_name=? "); + $sth->execute($city_name); + my $data = $sth->fetchrow; + return $data; +} + +=head2 getcategorytype (OUEST-PROVENCE) + +check for the category_type with categorycode +and return the category_type + +=cut + +sub getcategorytype { + my ($categorycode) = @_; + my $dbh = C4::Context->dbh; + my $sth = + $dbh->prepare( +"Select category_type,description from categories where categorycode=? " + ); + $sth->execute($categorycode); + my ( $category_type, $description ) = $sth->fetchrow; + return $category_type, $description; +} } -- 2.39.5