#
# 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 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 3 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.
+# 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.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
-use strict;
-
-#use warnings; FIXME - Bug 2505
-use CGI;
+use Modern::Perl;
+use CGI qw ( -utf8 );
use C4::Context;
use C4::Output;
-use C4::Dates qw(format_date format_date_in_iso);
-use C4::SQLHelper qw(:all);
-use C4::Debug;
use C4::Letters;
-use List::MoreUtils qw(any);
-use C4::Dates qw(format_date_in_iso);
+use C4::Biblio qw( GetMarcFromKohaField );
+use Koha::DateUtils qw( dt_from_string );
+use Koha::Suggestions;
+
use base qw(Exporter);
-our $VERSION = 3.07.00.049;
our @EXPORT = qw(
ConnectSuggestionAndBiblio
- CountSuggestion
DelSuggestion
GetSuggestion
GetSuggestionByStatus
NewSuggestion
SearchSuggestion
DelSuggestionsOlderThan
+ GetUnprocessedSuggestions
+ MarcRecordFromNewSuggestion
);
=head1 NAME
A suggestion is done in the OPAC. It has the status "ASKED"
-When a librarian manages the suggestion, he can set the status to "REJECTED" or "ACCEPTED".
+When a librarian manages the suggestion, they can set the status to "REJECTED" or "ACCEPTED".
When the book is ordered, the suggestion status becomes "ORDERED"
B1.branchname AS branchnamesuggestedby,
U1.surname AS surnamesuggestedby,
U1.firstname AS firstnamesuggestedby,
+ U1.cardnumber AS cardnumbersuggestedby,
U1.email AS emailsuggestedby,
U1.borrowernumber AS borrnumsuggestedby,
U1.categorycode AS categorycodesuggestedby,
B2.branchname AS branchnamesuggestedby,
U2.email AS emailmanagedby,
U2.branchcode AS branchcodemanagedby,
- U2.borrowernumber AS borrnummanagedby
+ U2.borrowernumber AS borrnummanagedby,
+ U3.surname AS surnamelastmodificationby,
+ U3.firstname AS firstnamelastmodificationby,
+ BU.budget_name AS budget_name
FROM suggestions
LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
LEFT JOIN branches AS B1 ON B1.branchcode=U1.branchcode
LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
LEFT JOIN branches AS B2 ON B2.branchcode=U2.branchcode
LEFT JOIN categories AS C2 ON C2.categorycode=U2.categorycode
+ LEFT JOIN borrowers AS U3 ON lastmodificationby=U3.borrowernumber
+ LEFT JOIN aqbudgets AS BU ON budgetid=BU.budget_id
WHERE 1=1
}
);
}
# filter on user branch
- if ( C4::Context->preference('IndependantBranches') ) {
+ if ( C4::Context->preference('IndependentBranches')
+ && !C4::Context->IsSuperLibrarian() )
+ {
+ # If IndependentBranches is set and the logged in user is not superlibrarian
+ # Then we want to filter by the user's library (i.e. cannot see suggestions from other libraries)
my $userenv = C4::Context->userenv;
if ($userenv) {
- if ( ( $userenv->{flags} % 2 ) != 1 && !$suggestion->{branchcode} )
{
push @sql_params, $$userenv{branch};
push @query, q{
};
}
}
- } else {
- if ( defined $suggestion->{branchcode} && $suggestion->{branchcode} ) {
- unless ( $suggestion->{branchcode} eq '__ANY__' ) {
- push @sql_params, $suggestion->{branchcode};
- push @query, qq{ AND suggestions.branchcode=? };
- }
- }
+ }
+ elsif (defined $suggestion->{branchcode}
+ && $suggestion->{branchcode}
+ && $suggestion->{branchcode} ne '__ANY__' )
+ {
+ # If IndependentBranches is not set OR the logged in user is not superlibrarian
+ # AND the branchcode filter is passed and not '__ANY__'
+ # Then we want to filter using this parameter
+ push @sql_params, $suggestion->{branchcode};
+ push @query, qq{ AND suggestions.branchcode=? };
}
# filter on nillable fields
qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
)
{
- if ( exists $suggestion->{$field} ) {
- if ( defined $suggestion->{$field} and $suggestion->{$field} ne '' )
- {
- push @sql_params, $suggestion->{$field};
- push @query, qq{ AND suggestions.$field=? };
+ if ( exists $suggestion->{$field}
+ and defined $suggestion->{$field}
+ and $suggestion->{$field} ne '__ANY__'
+ and (
+ $suggestion->{$field} ne q||
+ or $field eq 'STATUS'
+ )
+ ) {
+ if ( $suggestion->{$field} eq '__NONE__' ) {
+ push @query, qq{ AND (suggestions.$field = '' OR suggestions.$field IS NULL) };
}
else {
- push @query, qq{
- AND (suggestions.$field='' OR suggestions.$field IS NULL)
- };
+ push @sql_params, $suggestion->{$field};
+ push @query, qq{ AND suggestions.$field = ? };
}
}
}
# filter on date fields
- my $today = C4::Dates->today('iso');
+ my $dtf = Koha::Database->new->schema->storage->datetime_parser;
foreach my $field (qw( suggesteddate manageddate accepteddate )) {
my $from = $field . "_from";
my $to = $field . "_to";
- if ( $suggestion->{$from} || $suggestion->{$to} ) {
- push @query, qq{ AND suggestions.$field BETWEEN ? AND ? };
- push @sql_params,
- format_date_in_iso( $suggestion->{$from} ) || '0000-00-00';
- push @sql_params,
- format_date_in_iso( $suggestion->{$to} ) || $today;
+ my $from_dt;
+ $from_dt = eval { dt_from_string( $suggestion->{$from} ) } if ( $suggestion->{$from} );
+ my $to_dt;
+ $to_dt = eval { dt_from_string( $suggestion->{$to} ) } if ( $suggestion->{$to} );
+ if ( $from_dt ) {
+ push @query, qq{ AND suggestions.$field >= ?};
+ push @sql_params, $dtf->format_date($from_dt);
+ }
+ if ( $to_dt ) {
+ push @query, qq{ AND suggestions.$field <= ?};
+ push @sql_params, $dtf->format_date($to_dt);
}
}
- $debug && warn "@query";
+ # By default do not search for archived suggestions
+ unless ( exists $suggestion->{archived} && $suggestion->{archived} ) {
+ push @query, q{ AND suggestions.archived = 0 };
+ }
+
my $sth = $dbh->prepare("@query");
$sth->execute(@sql_params);
my @results;
=head2 GetSuggestion
-\%sth = &GetSuggestion($ordernumber)
+\%sth = &GetSuggestion($suggestionid)
-this function get the detail of the suggestion $ordernumber (input arg)
+this function get the detail of the suggestion $suggestionid (input arg)
return :
the result of the SQL query as a hash : $sth->fetchrow_hashref.
=cut
sub GetSuggestion {
- my ($ordernumber) = @_;
+ my ($suggestionid) = @_;
my $dbh = C4::Context->dbh;
my $query = q{
SELECT *
WHERE suggestionid=?
};
my $sth = $dbh->prepare($query);
- $sth->execute($ordernumber);
+ $sth->execute($suggestionid);
return ( $sth->fetchrow_hashref );
}
LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
WHERE status = ?
+ ORDER BY suggestionid
};
# filter on branch
- if ( C4::Context->preference("IndependantBranches") || $branchcode ) {
+ if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
my $userenv = C4::Context->userenv;
if ($userenv) {
- unless ( $userenv->{flags} % 2 == 1 ) {
+ unless ( C4::Context->IsSuperLibrarian() ) {
push @sql_params, $userenv->{branch};
$query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
}
$query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
}
}
-
+
my $sth = $dbh->prepare($query);
$sth->execute(@sql_params);
my $results;
return $results;
}
-=head2 CountSuggestion
-
-&CountSuggestion($status)
-
-Count the number of aqorders with the status given on input argument.
-the arg status can be :
-
-=over 2
-
-=item * ASKED : asked by the user, not dealed by the librarian
+=head2 NewSuggestion
-=item * ACCEPTED : accepted by the librarian, but not yet ordered
-=item * REJECTED : rejected by the librarian (definitive status)
+&NewSuggestion($suggestion);
-=item * ORDERED : ordered by the librarian (acquisition module)
+Insert a new suggestion on database with value given on input arg.
-=back
+=cut
-return :
-the number of suggestion with this status.
+sub NewSuggestion {
+ my ($suggestion) = @_;
-=cut
+ $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
-sub CountSuggestion {
- my ($status) = @_;
- my $dbh = C4::Context->dbh;
- my $sth;
- my $userenv = C4::Context->userenv;
- if ( C4::Context->preference("IndependantBranches")
- && $userenv->{flags} % 2 != 1 )
- {
- my $query = q{
- SELECT count(*)
- FROM suggestions
- LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
- WHERE STATUS=?
- AND (borrowers.branchcode='' OR borrowers.branchcode=?)
- };
- $sth = $dbh->prepare($query);
- $sth->execute( $status, $userenv->{branch} );
- }
- else {
- my $query = q{
- SELECT count(*)
- FROM suggestions
- WHERE STATUS=?
- };
- $sth = $dbh->prepare($query);
- $sth->execute($status);
- }
- my ($result) = $sth->fetchrow;
- return $result;
-}
+ $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
-=head2 NewSuggestion
+ delete $suggestion->{branchcode} if $suggestion->{branchcode} eq '';
+ my $suggestion_object = Koha::Suggestion->new( $suggestion )->store;
+ my $suggestion_id = $suggestion_object->suggestionid;
-&NewSuggestion($suggestion);
+ my $emailpurchasesuggestions = C4::Context->preference("EmailPurchaseSuggestions");
+ if ($emailpurchasesuggestions) {
+ my $full_suggestion = GetSuggestion( $suggestion_id); # We should not need to refetch it!
+ if (
+ my $letter = C4::Letters::GetPreparedLetter(
+ module => 'suggestions',
+ letter_code => 'NEW_SUGGESTION',
+ tables => {
+ 'branches' => $full_suggestion->{branchcode},
+ 'borrowers' => $full_suggestion->{suggestedby},
+ 'suggestions' => $full_suggestion,
+ },
+ )
+ ){
-Insert a new suggestion on database with value given on input arg.
+ my $toaddress;
+ if ( $emailpurchasesuggestions eq "BranchEmailAddress" ) {
+ my $library =
+ Koha::Libraries->find( $full_suggestion->{branchcode} );
+ $toaddress = $library->inbound_email_address;
+ }
+ elsif ( $emailpurchasesuggestions eq "KohaAdminEmailAddress" ) {
+ $toaddress = C4::Context->preference('ReplytoDefault')
+ || C4::Context->preference('KohaAdminEmailAddress');
+ }
+ else {
+ $toaddress =
+ C4::Context->preference($emailpurchasesuggestions)
+ || C4::Context->preference('ReplytoDefault')
+ || C4::Context->preference('KohaAdminEmailAddress');
+ }
-=cut
+ C4::Letters::EnqueueLetter(
+ {
+ letter => $letter,
+ borrowernumber => $full_suggestion->{suggestedby},
+ suggestionid => $full_suggestion->{suggestionid},
+ to_address => $toaddress,
+ message_transport_type => 'email',
+ }
+ ) or warn "can't enqueue letter $letter";
+ }
+ }
-sub NewSuggestion {
- my ($suggestion) = @_;
- $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
- return InsertInTable( "suggestions", $suggestion );
+ return $suggestion_id;
}
=head2 ModSuggestion
Modify the suggestion according to the hash passed by ref.
The hash HAS to contain suggestionid
-Data not defined is not updated unless it is a note or sort1
+Data not defined is not updated unless it is a note or sort1
Send a mail to notify the user that did the suggestion.
-Note that there is no function to modify a suggestion.
+Note that there is no function to modify a suggestion.
=cut
sub ModSuggestion {
my ($suggestion) = @_;
- my $status_update_table = UpdateInTable( "suggestions", $suggestion );
+ return unless( $suggestion and defined($suggestion->{suggestionid}) );
- if ( $suggestion->{STATUS} ) {
+ my $suggestion_object = Koha::Suggestions->find( $suggestion->{suggestionid} );
+ eval { # FIXME Must raise an exception instead
+ $suggestion_object->set($suggestion)->store;
+ };
+ return 0 if $@;
+
+ if ( $suggestion->{STATUS} && $suggestion_object->suggestedby ) {
# fetch the entire updated suggestion so that we can populate the letter
my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
+
+ my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
+
+ my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
+
if (
my $letter = C4::Letters::GetPreparedLetter(
module => 'suggestions',
letter_code => $full_suggestion->{STATUS},
branchcode => $full_suggestion->{branchcode},
+ lang => $patron->lang,
tables => {
'branches' => $full_suggestion->{branchcode},
'borrowers' => $full_suggestion->{suggestedby},
borrowernumber => $full_suggestion->{suggestedby},
suggestionid => $full_suggestion->{suggestionid},
LibraryName => C4::Context->preference("LibraryName"),
- message_transport_type => 'email',
+ message_transport_type => $transport,
}
) or warn "can't enqueue letter $letter";
}
}
- return $status_update_table;
+ return 1; # No useful if the exception is raised earlier
}
=head2 ConnectSuggestionAndBiblio
&DelSuggestion($borrowernumber,$ordernumber)
-Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
+Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
=cut
=head2 DelSuggestionsOlderThan
&DelSuggestionsOlderThan($days)
-
+
Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
-
+ We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
+
=cut
sub DelSuggestionsOlderThan {
my ($days) = @_;
- return unless $days;
+ return unless $days && $days > 0;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare(
q{
DELETE FROM suggestions
WHERE STATUS<>'ASKED'
- AND date < ADDDATE(NOW(), ?)
+ AND manageddate < ADDDATE(NOW(), ?)
}
);
$sth->execute("-$days");
}
+sub GetUnprocessedSuggestions {
+ my ( $number_of_days_since_the_last_modification ) = @_;
+
+ $number_of_days_since_the_last_modification ||= 0;
+
+ my $dbh = C4::Context->dbh;
+
+ my $s = $dbh->selectall_arrayref(q|
+ SELECT *
+ FROM suggestions
+ WHERE STATUS = 'ASKED'
+ AND budgetid IS NOT NULL
+ AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
+ |, { Slice => {} }, $number_of_days_since_the_last_modification );
+ return $s;
+}
+
+=head2 MarcRecordFromNewSuggestion
+
+ $record = MarcRecordFromNewSuggestion ( $suggestion )
+
+This function build a marc record object from a suggestion
+
+=cut
+
+sub MarcRecordFromNewSuggestion {
+ my ($suggestion) = @_;
+ my $record = MARC::Record->new();
+
+ my ($title_tag, $title_subfield) = GetMarcFromKohaField('biblio.title', '');
+ $record->append_fields(
+ MARC::Field->new($title_tag, ' ', ' ', $title_subfield => $suggestion->{title})
+ );
+
+ my ($author_tag, $author_subfield) = GetMarcFromKohaField('biblio.author', '');
+ if ($record->field( $author_tag )) {
+ $record->field( $author_tag )->add_subfields( $author_subfield => $suggestion->{author} );
+ }
+ else {
+ $record->append_fields(
+ MARC::Field->new($author_tag, ' ', ' ', $author_subfield => $suggestion->{author})
+ );
+ }
+
+ my ($it_tag, $it_subfield) = GetMarcFromKohaField('biblioitems.itemtype', '');
+ if ($record->field( $it_tag )) {
+ $record->field( $it_tag )->add_subfields( $it_subfield => $suggestion->{itemtype} );
+ }
+ else {
+ $record->append_fields(
+ MARC::Field->new($it_tag, ' ', ' ', $it_subfield => $suggestion->{itemtype})
+ );
+ }
+
+ return $record;
+}
+
1;
__END__