# 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 Modern::Perl;
use CGI qw ( -utf8 );
use C4::Context;
use C4::Output;
-use C4::Dates qw(format_date format_date_in_iso);
-use C4::Debug;
use C4::Letters;
+use C4::Biblio qw( GetMarcFromKohaField );
use Koha::DateUtils qw( dt_from_string );
+use Koha::Suggestions;
-use List::MoreUtils qw(any);
-use C4::Dates qw(format_date_in_iso);
use base qw(Exporter);
-our $VERSION = 3.07.00.049;
our @EXPORT = qw(
ConnectSuggestionAndBiblio
- CountSuggestion
DelSuggestion
GetSuggestion
GetSuggestionByStatus
ModStatus
ModSuggestion
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"
=head1 FUNCTIONS
-=head2 SearchSuggestion
-
-(\@array) = &SearchSuggestion($suggestionhashref_to_search)
-
-searches for a suggestion
-
-return :
-C<\@array> : the aqorders found. Array of hash.
-Note the status is stored twice :
-* in the status field
-* as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
-
-=cut
-
-sub SearchSuggestion {
- my ($suggestion) = @_;
- my $dbh = C4::Context->dbh;
- my @sql_params;
- my @query = (
- q{
- SELECT suggestions.*,
- U1.branchcode AS branchcodesuggestedby,
- 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,
- C1.description AS categorydescriptionsuggestedby,
- U2.surname AS surnamemanagedby,
- U2.firstname AS firstnamemanagedby,
- B2.branchname AS branchnamesuggestedby,
- U2.email AS emailmanagedby,
- U2.branchcode AS branchcodemanagedby,
- U2.borrowernumber AS borrnummanagedby
- FROM suggestions
- LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
- LEFT JOIN branches AS B1 ON B1.branchcode=U1.branchcode
- LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
- 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
- WHERE 1=1
- }
- );
-
- # filter on biblio informations
- foreach my $field (
- qw( title author isbn publishercode copyrightdate collectiontitle ))
- {
- if ( $suggestion->{$field} ) {
- push @sql_params, '%' . $suggestion->{$field} . '%';
- push @query, qq{ AND suggestions.$field LIKE ? };
- }
- }
-
- # filter on user branch
- if ( C4::Context->preference('IndependentBranches') ) {
- my $userenv = C4::Context->userenv;
- if ($userenv) {
- if ( !C4::Context->IsSuperLibrarian() && !$suggestion->{branchcode} )
- {
- push @sql_params, $$userenv{branch};
- push @query, q{
- AND (suggestions.branchcode=? OR suggestions.branchcode='')
- };
- }
- }
- } else {
- if ( defined $suggestion->{branchcode} && $suggestion->{branchcode} ) {
- unless ( $suggestion->{branchcode} eq '__ANY__' ) {
- push @sql_params, $suggestion->{branchcode};
- push @query, qq{ AND suggestions.branchcode=? };
- }
- }
- }
-
- # filter on nillable fields
- foreach my $field (
- qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
- )
- {
- if ( exists $suggestion->{$field}
- and defined $suggestion->{$field}
- and $suggestion->{$field} ne '__ANY__'
- and $suggestion->{$field} ne q||
- ) {
- if ( $suggestion->{$field} eq '__NONE__' ) {
- push @query, qq{ AND (suggestions.$field = '' OR suggestions.$field IS NULL) };
- }
- else {
- push @sql_params, $suggestion->{$field};
- push @query, qq{ AND suggestions.$field = ? };
- }
- }
- }
-
- # filter on date fields
- my $today = C4::Dates->today('iso');
- 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;
- }
- }
-
- $debug && warn "@query";
- my $sth = $dbh->prepare("@query");
- $sth->execute(@sql_params);
- my @results;
-
- # add status as field
- while ( my $data = $sth->fetchrow_hashref ) {
- $data->{ $data->{STATUS} } = 1;
- push( @results, $data );
- }
-
- return ( \@results );
-}
-
=head2 GetSuggestion
\%sth = &GetSuggestion($suggestionid)
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
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
-
-=item * ACCEPTED : accepted by the librarian, but not yet ordered
-
-=item * REJECTED : rejected by the librarian (definitive status)
-
-=item * ORDERED : ordered by the librarian (acquisition module)
-
-=back
-
-return :
-the number of suggestion with this status.
-
-=cut
-
-sub CountSuggestion {
- my ($status) = @_;
- my $dbh = C4::Context->dbh;
- my $sth;
- my $userenv = C4::Context->userenv;
- if ( C4::Context->preference("IndependentBranches")
- && !C4::Context->IsSuperLibrarian() )
- {
- 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;
-}
-
=head2 NewSuggestion
sub NewSuggestion {
my ($suggestion) = @_;
- for my $field ( qw(
- suggestedby
- managedby
- manageddate
- acceptedby
- accepteddate
- rejectedby
- rejecteddate
- budgetid
- ) ) {
- # Set the fields to NULL if not given.
- $suggestion->{$field} ||= undef;
- }
-
$suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
$suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
- my $rs = Koha::Database->new->schema->resultset('Suggestion');
- return $rs->create($suggestion)->id;
+ delete $suggestion->{branchcode}
+ if defined $suggestion->{branchcode} and $suggestion->{branchcode} eq '';
+
+ my $suggestion_object = Koha::Suggestion->new( $suggestion )->store;
+ my $suggestion_id = $suggestion_object->suggestionid;
+
+ 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,
+ },
+ )
+ ){
+
+ 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');
+ }
+
+ 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";
+ }
+ }
+
+ return $suggestion_id;
}
=head2 ModSuggestion
my ($suggestion) = @_;
return unless( $suggestion and defined($suggestion->{suggestionid}) );
- for my $field ( qw(
- suggestedby
- managedby
- manageddate
- acceptedby
- accepteddate
- rejectedby
- rejecteddate
- budgetid
- ) ) {
- # Set the fields to NULL if not given.
- $suggestion->{$field} = undef
- if exists $suggestion->{$field}
- and ($suggestion->{$field} eq '0'
- or $suggestion->{$field} eq '' );
- }
-
- my $rs = Koha::Database->new->schema->resultset('Suggestion')->find($suggestion->{suggestionid});
- my $status_update_table = 1;
- eval {
- $rs->update($suggestion);
+ my $suggestion_object = Koha::Suggestions->find( $suggestion->{suggestionid} );
+ eval { # FIXME Must raise an exception instead
+ $suggestion_object->set($suggestion)->store;
};
- $status_update_table = 0 if( $@ );
+ return 0 if $@;
- if ( $suggestion->{STATUS} ) {
+ 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
my $sth = $dbh->prepare($query);
$sth->execute($suggestionid);
my ($suggestedby) = $sth->fetchrow;
- if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
+ $suggestedby //= '';
+ $borrowernumber //= '';
+ if ( defined $type && $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
my $queryDelete = q{
DELETE FROM suggestions
WHERE suggestionid=?
&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");
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();
+
+ if (my $isbn = $suggestion->{isbn}) {
+ for my $field (qw(biblioitems.isbn biblioitems.issn)) {
+ my ($tag, $subfield) = GetMarcFromKohaField($field);
+ $record->append_fields(
+ MARC::Field->new($tag, ' ', ' ', $subfield => $isbn)
+ );
+ }
+ }
+ else {
+ 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__
projects / koha-ffzg.git / blobdiff