#!/usr/bin/perl package C4::Claimer; use Moose; use feature ":5.10"; use YAML; use C4::Letters; has claim_string1 => ( is => 'rw', isa => 'Str', default => " DO BK 1 1 CLAIM1 DO IBK 1 1 CLAIM1 DO ITH 1 1 CLAIM1 DO BK 8 1 CLAIM2 DO IBK 8 1 CLAIM2 DO ITH 8 1 CLAIM2 DO BK 15 1 CLAIM3 DO IBK 15 1 CLAIM3 DO ITH 15 1 CLAIM3 DO BK 18 2 DEBARRE DO IBK 18 2 DEBARRE DO ITH 18 2 DEBARRE TA BK 1 1 CLAIM1 TA IBK 1 1 CLAIM1 TA ITH 1 1 CLAIM1 TA BK 8 1 CLAIM2 TA IBK 8 1 CLAIM2 TA ITH 8 1 CLAIM2 TA BK 15 1 CLAIM3 TA IBK 15 1 CLAIM3 TA ITH 15 1 CLAIM3 DO BK 18 2 DEBARRE DO IBK 18 2 DEBARRE DO ITH 18 2 DEBARRE DO BKS 1 1 CLAIM1 DO AV 1 1 CLAIM1 DO BKS 3 1 CLAIM2 DO AV 3 1 CLAIM2 DO BKS 5 1 CLAIM3 DO AV 5 1 CLAIM3 DO BK 7 2 DEBARRE DO ITH 7 2 DEBARRE DO BKS 1 1 CLAIM1 DO AV 1 1 CLAIM1 DO BKS 3 1 CLAIM2 DO AV 3 1 CLAIM2 DO BKS 5 1 CLAIM3 DO AV 5 1 CLAIM3 DO BK 7 2 DEBARRE DO ITH 7 2 DEBARRE "); has claim_string => ( is => 'rw', isa => 'Str', default => " # Branch itype days action notice # action => 1=email, 2=debarre * BK 1 1 CLAIM1 * IBK 1 1 CLAIM1 * ITH 1 1 CLAIM1 * BKS 1 1 CLAIM1 * AV 1 1 CLAIM1 * BK 8 1 CLAIM2 * IBK 8 1 CLAIM2 * ITH 8 1 CLAIM2 * BK 15 1 CLAIM3 * IBK 15 1 CLAIM3 * ITH 15 1 CLAIM3 * BK 18 2 DEBARRE * IBK 18 2 DEBARRE * ITH 18 2 DEBARRE * BKS 3 1 CLAIM2 * AV 3 1 CLAIM2 * BKS 5 1 CLAIM3 * AV 5 1 CLAIM3 * BK 7 2 DEBARRE * ITH 7 2 DEBARRE "); has rule => ( is => 'rw', isa => 'HashRef' ); has doit => ( is => 'rw', isa => 'Bool', default => 0 ); sub BUILD { my $self = shift; my $rule = {}; for ( split /\n/, $self->claim_string ) { next if $_ eq '' || /^#/; my ($branch, $itype, $day, $action, $notice) = split; $rule->{"$branch-$itype-$day"} = { action => $action, notice => $notice, letter => C4::Letters::getletter('circulation', $notice), }; } $self->rule($rule); } # # Claim a specific issue # sub claim { my ($self, $itemnumber, $rule) = @_; my $dbh = C4::Context->dbh(); # FIXME Selected branches should be a parameter. Here we take item # branchcode, but it could be issue or borrower branch # ie: AND branches.branchcode = borrower.branchcode # or AND branches.branchcode = issue.branchcode my $sth = $dbh->prepare(" SELECT borrowers.*, items.*, biblio.*, biblioitems.*, branches.*, issues.date_due, overduenoticerequired, TO_DAYS(NOW())-TO_DAYS(date_due) AS overdue_days FROM issues, borrowers, items, categories, biblio, biblioitems, branches WHERE issues.itemnumber = ? AND borrowers.borrowernumber = issues.borrowernumber AND items.itemnumber = issues.itemnumber AND biblio.biblionumber = items.biblionumber AND biblioitems.biblionumber = items.biblionumber AND categories.categorycode = borrowers.categorycode AND branches.branchcode = items.homebranch "); $sth->execute($itemnumber); my $issue = $sth->fetchrow_hashref; # Skip issue from borrower of specific category return unless $issue->{overduenoticerequired}; # Substitute letter placeholder with fields values my %letter = %{$rule->{letter}}; my $content = $letter{content}; while ( 1 ) { last unless $content =~ /<<(.*?)>>/; my $name = $1; if ( exists $issue->{$name} ) { my $value = $issue->{$name} || ''; $content =~ s/<<$name>>/$value/; next; } if ( $name =~ /.*\.(.*)/ ) { my $short_name = $1; if ( exists $issue->{$short_name} ) { my $value = $issue->{$short_name} || ''; $content =~ s/<<$name>>/$value/; next; } } $content =~ s/<<$name>>/unknown $name/; } $content =~ s///g; $content =~ s/<\/items>//g; $letter{content} = $content; if ( $self->doit ) { C4::Letters::EnqueueLetter( { letter => \%letter, borrowernumber => $issue->{borrowernumber}, message_transport_type => 'email', from_address => $issue->{branchemail}, } ); } else { print "$content\n\n"; } } sub claim_all_overdues { my $self = shift; my $dbh = C4::Context->dbh(); my $sth = $dbh->prepare(" SELECT borrowers.borrowernumber, issues.itemnumber, issues.branchcode, itype, TO_DAYS(NOW())-TO_DAYS(date_due) AS day FROM issues, borrowers, items WHERE date_due < NOW() AND borrowers.borrowernumber = issues.borrowernumber AND items.itemnumber = issues.itemnumber "); $sth->execute; my $borrower = { borrowernumber => 0 }; while ( my ($borrowernumber, $itemnumber, $branch, $itype, $day) = $sth->fetchrow ) { my $rule = $self->rule->{"$branch-$itype-$day"} || $self->rule->{"*-$itype-$day"} || $self->rule->{"$branch-*-$day"} || $self->rule->{"*-*-$day"}; next unless $rule; given ($rule->{action}) { when (1) { $self->claim($itemnumber, $rule); } when (2) { ; } } } } package main; use strict; use warnings; use Pod::Usage; use Getopt::Long; my $verbose = 0; my $help = 0; my $doit = 0; GetOptions( 'verbose' => \$verbose, 'help' => \$help, 'doit' => \$doit, ); usage() if $help; binmode(STDOUT, ':utf8'); my $claimer = C4::Claimer->new( doit => $doit ); $claimer->claim_all_overdues( ); sub usage { pod2usage( -verbose => 2 ); } =head1 NAME koha-claim - Claim overdues =head1 SYNOPSYS koha-claim koha-claim --doit =head1 COPYRIGHT AND LICENSE Copyright 2011 by Tamil, s.a.r.l. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl 5 itself. =cut