#Get data
push @EXPORT, qw(
- &GetPendingIssues
&GetAllIssues
&GetBorrowersToExpunge
#Insert data
push @EXPORT, qw(
- &AddMember
&AddMember_Auto
&AddMember_Opac
);
#Check data
push @EXPORT, qw(
&checkuserpassword
- &Check_Userid
- &Generate_Userid
- &fixup_cardnumber
&checkcardnumber
);
}
return $execute_success;
}
-=head2 AddMember
-
- $borrowernumber = &AddMember(%borrower);
-
-insert new borrower into table
-
-(%borrower keys are database columns. Database columns could be
-different in different versions. Please look into database for correct
-column names.)
-
-Returns the borrowernumber upon success
-
-Returns as undef upon any db error without further processing
-
-=cut
-
-#'
-sub AddMember {
- my (%data) = @_;
- my $dbh = C4::Context->dbh;
- my $schema = Koha::Database->new()->schema;
-
- my $category = Koha::Patron::Categories->find( $data{categorycode} );
- unless ($category) {
- Koha::Exceptions::BadParameter->throw(
- error => 'Invalid parameter passed',
- parameter => 'categorycode'
- );
- }
-
- # trim whitespace from data which has some non-whitespace in it.
- foreach my $field_name (keys(%data)) {
- if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
- $data{$field_name} =~ s/^\s*|\s*$//g;
- }
- }
-
- # generate a proper login if none provided
- $data{'userid'} = Generate_Userid( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} )
- if ( $data{'userid'} eq '' || !Check_Userid( $data{'userid'} ) );
-
- # add expiration date if it isn't already there
- $data{dateexpiry} ||= $category->get_expiry_date;
-
- # add enrollment date if it isn't already there
- unless ( $data{'dateenrolled'} ) {
- $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
- }
-
- if ( C4::Context->preference("autoMemberNum") ) {
- if ( not exists $data{cardnumber} or not defined $data{cardnumber} or $data{cardnumber} eq '' ) {
- $data{cardnumber} = fixup_cardnumber( $data{cardnumber} );
- }
- }
-
- $data{'privacy'} =
- $category->default_privacy() eq 'default' ? 1
- : $category->default_privacy() eq 'never' ? 2
- : $category->default_privacy() eq 'forever' ? 0
- : undef;
-
- $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
-
- # Make a copy of the plain text password for later use
- my $plain_text_password = $data{'password'};
-
- # create a disabled account if no password provided
- $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
-
- # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
- $data{'dateofbirth'} = undef if ( not $data{'dateofbirth'} );
- $data{'debarred'} = undef if ( not $data{'debarred'} );
- $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
- $data{'guarantorid'} = undef if ( not $data{'guarantorid'} );
-
- # get only the columns of Borrower
- # FIXME Do we really need this check?
- my @columns = $schema->source('Borrower')->columns;
- my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) } ;
-
- delete $new_member->{borrowernumber};
-
- my $patron = Koha::Patron->new( $new_member )->store;
- $data{borrowernumber} = $patron->borrowernumber;
-
- # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
- # cronjob will use for syncing with NL
- if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
- Koha::Database->new->schema->resultset('BorrowerSync')->create({
- 'borrowernumber' => $data{'borrowernumber'},
- 'synctype' => 'norwegianpatrondb',
- 'sync' => 1,
- 'syncstatus' => 'new',
- 'hashed_pin' => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
- });
- }
-
- logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
-
- $patron->add_enrolment_fee_if_needed;
-
- return $data{borrowernumber};
-}
-
-=head2 Check_Userid
-
- my $uniqueness = Check_Userid($userid,$borrowernumber);
-
- $borrowernumber is optional (i.e. it can contain a blank value). If $userid is passed with a blank $borrowernumber variable, the database will be checked for all instances of that userid (i.e. userid=? AND borrowernumber != '').
-
- If $borrowernumber is provided, the database will be checked for every instance of that userid coupled with a different borrower(number) than the one provided.
-
- return :
- 0 for not unique (i.e. this $userid already exists)
- 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
-
-=cut
-
-sub Check_Userid {
- my ( $uid, $borrowernumber ) = @_;
-
- return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
-
- return 0 if ( $uid eq C4::Context->config('user') );
-
- my $rs = Koha::Database->new()->schema()->resultset('Borrower');
-
- my $params;
- $params->{userid} = $uid;
- $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber);
-
- my $count = $rs->count( $params );
-
- return $count ? 0 : 1;
-}
-
-=head2 Generate_Userid
-
- my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
-
- Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
-
- $borrowernumber is optional (i.e. it can contain a blank value). A value is passed when generating a new userid for an existing borrower. When a new userid is created for a new borrower, a blank value is passed to this sub.
-
- return :
- new userid ($firstname.$surname if there is a $firstname, or $surname if there is no value in $firstname) plus offset (0 if the $newuid is unique, or a higher numeric value if Check_Userid finds an existing match for the $newuid in the database).
-
-=cut
-
-sub Generate_Userid {
- my ($borrowernumber, $firstname, $surname) = @_;
- my $newuid;
- my $offset = 0;
- #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
- do {
- $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
- $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
- $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
- $newuid = unac_string('utf-8',$newuid);
- $newuid .= $offset unless $offset == 0;
- $offset++;
-
- } while (!Check_Userid($newuid,$borrowernumber));
-
- return $newuid;
-}
-
-=head2 fixup_cardnumber
-
-Warning: The caller is responsible for locking the members table in write
-mode, to avoid database corruption.
-
-=cut
-
-sub fixup_cardnumber {
- my ($cardnumber) = @_;
- my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
-
- # Find out whether member numbers should be generated
- # automatically. Should be either "1" or something else.
- # Defaults to "0", which is interpreted as "no".
-
- ($autonumber_members) or return $cardnumber;
- my $dbh = C4::Context->dbh;
-
- my $sth = $dbh->prepare(
- 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
- );
- $sth->execute;
- my ($result) = $sth->fetchrow;
- return $result + 1;
-}
-
-=head2 GetPendingIssues
-
- my $issues = &GetPendingIssues(@borrowernumber);
-
-Looks up what the patron with the given borrowernumber has borrowed.
-
-C<&GetPendingIssues> returns a
-reference-to-array where each element is a reference-to-hash; the
-keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
-The keys include C<biblioitems> fields.
-
-=cut
-
-sub GetPendingIssues {
- my @borrowernumbers = @_;
-
- unless (@borrowernumbers ) { # return a ref_to_array
- return \@borrowernumbers; # to not cause surprise to caller
- }
-
- # Borrowers part of the query
- my $bquery = '';
- for (my $i = 0; $i < @borrowernumbers; $i++) {
- $bquery .= ' issues.borrowernumber = ?';
- if ($i < $#borrowernumbers ) {
- $bquery .= ' OR';
- }
- }
-
- # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
- # FIXME: circ/ciculation.pl tries to sort by timestamp!
- # FIXME: namespace collision: other collisions possible.
- # FIXME: most of this data isn't really being used by callers.
- my $query =
- "SELECT issues.*,
- items.*,
- biblio.*,
- biblioitems.volume,
- biblioitems.number,
- biblioitems.itemtype,
- biblioitems.isbn,
- biblioitems.issn,
- biblioitems.publicationyear,
- biblioitems.publishercode,
- biblioitems.volumedate,
- biblioitems.volumedesc,
- biblioitems.lccn,
- biblioitems.url,
- borrowers.firstname,
- borrowers.surname,
- borrowers.cardnumber,
- issues.timestamp AS timestamp,
- issues.renewals AS renewals,
- issues.borrowernumber AS borrowernumber,
- items.renewals AS totalrenewals
- FROM issues
- LEFT JOIN items ON items.itemnumber = issues.itemnumber
- LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
- LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
- LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
- WHERE
- $bquery
- ORDER BY issues.issuedate"
- ;
-
- my $sth = C4::Context->dbh->prepare($query);
- $sth->execute(@borrowernumbers);
- my $data = $sth->fetchall_arrayref({});
- my $today = dt_from_string;
- foreach (@{$data}) {
- if ($_->{issuedate}) {
- $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
- }
- $_->{date_due_sql} = $_->{date_due};
- # FIXME no need to have this value
- $_->{date_due} or next;
- $_->{date_due_sql} = $_->{date_due};
- # FIXME no need to have this value
- $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
- if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
- $_->{overdue} = 1;
- }
- }
- return $data;
-}
-
=head2 GetAllIssues
$issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
<<issues.*>>
</checkedout>
- NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
+ NOTE: Fields from tables issues, items, biblio and biblioitems are available
=cut
my $patron = Koha::Patrons->find( $borrowernumber );
return unless $patron;
- my @issues = @{ GetPendingIssues($borrowernumber) };
-
- for my $issue (@issues) {
- $issue->{date_due} = $issue->{date_due_sql};
- if ($quickslip) {
- my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
- if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
- or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
- $issue->{now} = 1;
- };
- }
- }
-
- # Sort on timestamp then on issuedate then on issue_id
- # useful for tests and could be if modified in a batch
- @issues = sort {
- $b->{timestamp} <=> $a->{timestamp}
- or $b->{issuedate} <=> $a->{issuedate}
- or $b->{issue_id} <=> $a->{issue_id}
- } @issues;
+ my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
my ($letter_code, %repeat, %loops);
if ( $quickslip ) {
+ my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
+ my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
+ $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
+ $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
$letter_code = 'ISSUEQSLIP';
- my @checkouts = map {
- 'biblio' => $_,
- 'items' => $_,
- 'biblioitems' => $_,
- 'issues' => $_,
- }, grep { $_->{'now'} } @issues;
+
+ # issue date or lastreneweddate is today
+ my $todays_checkouts = $pending_checkouts->search(
+ {
+ -or => {
+ issuedate => {
+ '>=' => $today_start,
+ '<=' => $today_end,
+ },
+ lastreneweddate =>
+ { '>=' => $today_start, '<=' => $today_end, }
+ }
+ }
+ );
+ my @checkouts;
+ while ( my $c = $todays_checkouts->next ) {
+ my $all = $c->unblessed_all_relateds;
+ push @checkouts, {
+ biblio => $all,
+ items => $all,
+ biblioitems => $all,
+ issues => $all,
+ };
+ }
+
%repeat = (
- checkedout => \@checkouts, # History syntax
+ checkedout => \@checkouts, # Historical syntax
);
%loops = (
issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
);
}
else {
- my @checkouts = map {
- 'biblio' => $_,
- 'items' => $_,
- 'biblioitems' => $_,
- 'issues' => $_,
- }, grep { !$_->{'overdue'} } @issues;
- my @overdues = map {
- 'biblio' => $_,
- 'items' => $_,
- 'biblioitems' => $_,
- 'issues' => $_,
- }, grep { $_->{'overdue'} } @issues;
+ my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
+ # Checkouts due in the future
+ my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
+ my @checkouts; my @overdues;
+ while ( my $c = $checkouts->next ) {
+ my $all = $c->unblessed_all_relateds;
+ push @checkouts, {
+ biblio => $all,
+ items => $all,
+ biblioitems => $all,
+ issues => $all,
+ };
+ }
+
+ # Checkouts due in the past are overdues
+ my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
+ while ( my $o = $overdues->next ) {
+ my $all = $o->unblessed_all_relateds;
+ push @overdues, {
+ biblio => $all,
+ items => $all,
+ biblioitems => $all,
+ issues => $all,
+ };
+ }
my $news = GetNewsToDisplay( "slip", $branch );
my @news = map {
$_->{'timestamp'} = $_->{'newdate'};
sub AddMember_Auto {
my ( %borrower ) = @_;
- $borrower{'cardnumber'} ||= fixup_cardnumber();
-
- $borrower{'borrowernumber'} = AddMember(%borrower);
+ my $patron = Koha::Patron->new(\%borrower)->store;
- return ( %borrower );
+ return %{ $patron->unblessed };
}
=head2 AddMember_Opac
my ( %borrower ) = @_;
$borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
- if (not defined $borrower{'password'}){
+ my $password = $borrower{password};
+ if (not defined $password){
my $sr = new String::Random;
$sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
- my $password = $sr->randpattern("AAAAAAAAAA");
+ $password = $sr->randpattern("AAAAAAAAAA");
$borrower{'password'} = $password;
}
%borrower = AddMember_Auto(%borrower);
- return ( $borrower{'borrowernumber'}, $borrower{'password'} );
+ return ( $borrower{'borrowernumber'}, $password );
}
=head2 DeleteExpiredOpacRegistrations
projects / koha.git / blobdiff