Attachment #105543 for bug #22417

View | Details | Raw Unified | Return to bug 22417
Collapse All | Expand All




package Koha::Prosentient::MQ;

use Modern::Perl;
use Module::Load::Conditional qw/check_install/;
use C4::Context;

sub _get_config {
    my $config;
    my $context = C4::Context->new();
    if ($context && $context->{prosentient} && $context->{prosentient}->{message_broker}){
        $config = $context->{prosentient}->{message_broker};
    }
    return $config;
}

sub is_supported {
    my $supported = 0;
    my $stomp_lib = check_install( module => 'Net::Stomp' );
    my $config = _get_config();
    if ($stomp_lib && $config){
        $supported = 1;
    }
    return $supported;
}

sub queue {
    my ($queue_id) = @_;
    my $queue;
    if ( is_supported() ){
        my $config = _get_config();
        if ($config && $config->{queue} && $queue_id){
            my $queue_config = $config->{queue}->{$queue_id};
            if ($queue_config && $queue_config->{dest}){
                $queue = $queue_config->{dest};
            }
        }
    }
    return $queue;
}

sub queues {
    my @queues = ();
    if ( is_supported() ){
        my $config = _get_config();
        if ($config){
            my $queue_hash = $config->{queue};
            foreach my $queue_id (keys %$queue_hash){
                my $queue_config = $queue_hash->{$queue_id};
                if ($queue_config && $queue_config->{dest}){
                    my $queue = {
                        id => $queue_id,
                        dest => $queue_config->{dest},
                    };
                    push(@queues,$queue);
                }
            }
        }
    }
    return \@queues;
}

sub connection {
    my $connection;
    if ( is_supported() ){
        #NOTE: During the experimental phase, lazy load this library
        require Net::Stomp;
        my $config = _get_config();
        if ($config){
            my $stomp = Net::Stomp->new( { hostname => $config->{hostname}, port => $config->{port} } );
            my $frame = $stomp->connect( { login => $config->{user}, passcode => $config->{password}, host => $config->{vhost} } );
            if ($frame && $frame->command eq 'CONNECTED'){
                $connection = $stomp;   
            }
        }
    }
    return $connection;
}

1;




package Koha::Prosentient::MQ::AuditAuthorities;

use Modern::Perl;
use Template;
use Mail::Sendmail;
use Email::Valid;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use Encode;
use MIME::QuotedPrint;
use MIME::Base64;

use C4::Context;
use Koha::Database;
use Koha::MarcSubfieldStructures;
use Koha::Biblios;

my $email_template = <<EMAIL_TEMPLATE;
<html>
    <head>
        <style type="text/css">
            table, tr, th, td {
                border-style: solid;
            }
        </style>
    </head>
    <body>
        <table>
            <tr>
                <th>Biblionumber</th>
                <th>Tag</th>
                <th>Auth type</th>
                <th>Bib heading</th>
                <th>Linkage in bib</th>
                <th>Description</th>
                <th>Matched authority id</th>
                <th>Matched authority heading</th>
            </tr>
            [% FOREACH result IN results %]
            <tr>
                <td>[% result.biblionumber %]</td>
                <td>[% result.field %]$[% result.subfield %]</td>
                <td>[% result.authtypecode %]</td>
                <td>[% result.bib_full %]</td>
                <td>[% result.linkage %]</td>
                <td>[% result.desc %]</td>
                <td>[% result.matched_id %]</td>
                <td>[% result.matched_heading %]</td>
            </tr>
            [% END %]
        </table>
    </body>
</html>
EMAIL_TEMPLATE

sub do_task {
    my ($class,$args) = @_;
    my $completed = 1;
    my $debug = $args->{debug} // 0;
    my $field = $args->{field};
    my $subfield = $args->{subfield};
    my $authtypecode = $args->{authtypecode};
    my $email = $args->{email};
    $debug && warn __PACKAGE__ . " " . "starting task";
    if ($field && $subfield && $authtypecode){
        my $results = _get_results({
            field => $field,
            subfield => $subfield,
            authtypecode => $authtypecode,
        });
        if (@$results){
            $debug && warn __PACKAGE__ . " " . scalar @$results . " results";
            my $report = _create_report({
                results => $results,       
            });
            if ($report){
                $debug && warn __PACKAGE__ . " " . "report created";
                my $sent = _email_report({
                    email => $email,
                    report => $report,
                    tag => $field . '$' . $subfield,
                });
                if ($sent){
                    $debug && warn __PACKAGE__ . " " . "email sent";
                }
            }
        }
    }
    $debug && warn __PACKAGE__ . " " . "completed task";
    return $completed;
}

sub _email_report {
    my ($args) = @_;
    my $sent;
    my $email = $args->{email};
    my $report = $args->{report};
    my $tag = $args->{tag};
    if ($email && $report && $tag){
        if ( Email::Valid->address($email) ){
            my $zip = Archive::Zip->new();
            $zip->addString(Encode::encode("UTF-8",$report),"authorityreport_$tag.html");
            my $memory_file = ''; #scalar as a file
            open(my $fh, '>', \$memory_file);
            my $status = $zip->writeToFileHandle($fh);
            if ($status == AZ_OK){
                $fh->close;
                my $zipfile = encode_base64($memory_file);

                my %mail = ();
                $mail{from} = 'ADMIN@DOMAIN.com';
                $mail{to} = $email;
                $mail{subject} = Encode::encode("UTF-8","Authorities audit report for your catalogue on tag $tag");
                my $boundary = "====" . time() . "====";
                $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
                $boundary = '--' . $boundary;
                my $body = encode_qp(Encode::encode("UTF-8","<html><body>Please find attached your authorities audit report for review.</body></html>"));
                $mail{body} = <<END_OF_BODY;
$boundary
Content-Type: text/html; charset="utf-8"
Content-Transfer-Encoding: quoted-printable

$body
$boundary
Content-Type: application/octet-stream; name="authorityreport_$tag.zip"
Content-Transfer-Encoding: base64
Content-Disposition: attachment; filename="authorityreport_$tag.zip"

$zipfile
$boundary--
END_OF_BODY
                if ( sendmail %mail ) {
                    $sent = 1;
                }
            }
        }
    }
    return $sent;
}

sub _get_results {
    my ($args) = @_;
    my @results = ();
    my $field = $args->{field};
    my $subfield = $args->{subfield};
    my $authtypecode = $args->{authtypecode};
    if ($field && $subfield && $authtypecode){

        my $schema = Koha::Database->new->schema;
        my $authtype = $schema->resultset('AuthType')->search({
            authtypecode => $authtypecode,
        })->first;

        my $auth_tag = $authtype->auth_tag_to_report;
        
        my %auth_lookup_by_id = ();
        my %auth_lookup_by_full = ();
        my %auth_lookup_by_primary = ();
        my $dbh = C4::Context->dbh;
        my $sql = qq~
            SELECT
                authid,
                ExtractValue(marcxml,'//datafield[\@tag="$auth_tag"]/*') as full_header,
                ExtractValue(marcxml,'//datafield[\@tag="$auth_tag"]/subfield[\@code="a"]') as primary_header
            FROM auth_header
            WHERE authtypecode = ?
        ~;
        my $sth = $dbh->prepare($sql);
        $sth->execute($authtypecode);
        while (my $row = $sth->fetchrow_hashref){
            $auth_lookup_by_id{ $row->{authid} } = { full => $row->{full_header}, primary => $row->{primary_header}, };
            if ( ! $auth_lookup_by_full{ $row->{full_header} } ){
                $auth_lookup_by_full{ $row->{full_header} } = [];
            }
            push(@{$auth_lookup_by_full{ $row->{full_header} }},$row->{authid});

            if ( ! $auth_lookup_by_primary{ $row->{primary_header} } ){
                $auth_lookup_by_primary{ $row->{primary_header} }= [];
            }
            push(@{$auth_lookup_by_primary{ $row->{primary_header} }},$row->{authid});
        }


        my @frameworks_to_audit = Koha::MarcSubfieldStructures->search(
            {
                tagfield => $field,
                tagsubfield => $subfield,
                authtypecode => $authtypecode,
            }
        );
        my @search_conditions = ();
        foreach my $structure (@frameworks_to_audit){
            my $frameworkcode = $structure->frameworkcode;
            my $condition = { frameworkcode => $frameworkcode };
            push(@search_conditions,$condition);
        }



        my @biblios = Koha::Biblios->search(\@search_conditions);
        foreach my $biblio (@biblios){
            my $record = $biblio->metadata->record;
            if ($record){
                my @marc_fields = $record->field($field);
                foreach my $marc_field (@marc_fields){
                    my $result = {
                        biblionumber => $biblio->biblionumber,
                        field => $field,
                        subfield => $subfield,
                        bib_full => '',
                        authtypecode => $authtypecode,
                        linkage => '',
                        matched_heading => '',
                        matched_id => '',
                        desc => 'Unlinked and no match',
                    };
                    #Check if it already has a $9 linkage
                    my $bib_field = $marc_field->clone();
                    my $linkage = $bib_field->subfield('9');
                    $bib_field->delete_subfield('9');
                    my $bib_subfield = $bib_field->subfield($subfield);
                    my $bib_full = $bib_field->as_string;
                    $result->{bib_full} = $bib_full;
                    if ( $linkage){
                        my $linked_auth = $auth_lookup_by_id{ $linkage };
                        if ($linked_auth){
                            $result->{linkage} = $linkage;
                            if ( $linked_auth->{full} eq $bib_field->as_string){
                                $result->{desc} = "Linked heading 100% match";
                                $result->{matched_heading} = $linked_auth->{full};
                            } elsif ( $bib_subfield && $linked_auth->{primary} eq $bib_subfield ){
                                $result->{desc} = "Linked heading partial match";
                                $result->{matched_heading} = $linked_auth->{primary};
                                
                            } else {
                                $result->{desc} = "Linked heading does not match";
                                $result->{matched_heading} = $linked_auth->{full};
                            }
                        } else {
                            $result->{desc} = "Linked but unable to find authority record";
                        }
                    } else {
                        my $full_match = $auth_lookup_by_full{ $bib_full };
                        if ($full_match) {
                            $result->{desc} = "Unlinked but found 100% match";
                            $result->{matched_id} = join(',',@$full_match);
                            $result->{matched__heading} = $bib_full;
                        } else {
                            if ($bib_subfield){
                                my $primary_match = $auth_lookup_by_primary{ $bib_subfield };
                                if ($primary_match){
                                    $result->{desc} = "Unlinked but found partial match";
                                    $result->{matched_id} = join(',',@$primary_match);
                                    $result->{matched_heading} = $bib_subfield;
                                }
                            }
                        }
                    }
                    push(@results,$result);
                }
            }
        }
    }
    return \@results;
}

1;

sub _get_template {
    my $template;
    while (my $line = <DATA>){
        $template .= $line;
    }
    return $template;
}

sub _create_report {
    my ($args) = @_;
    my $report;
    my $results = $args->{results};
    if ($results){
        my $template_engine = Template->new({ ENCODING => 'UTF-8', });
        my $template = $email_template;
        $template_engine->process(\$template, { results => $results, }, \$report);
    }
    return $report;
}





# koha-mq-scheduler@.service
# /etc/systemd/system/koha-mq-scheduler@.service
[Unit]
Description=Koha Message Queue Work Scheduler
After=syslog.target network.target rabbitmq-server.service

[Service]
Environment=PERL5LIB=/KOHA/%i/lib
Environment=KOHA_CONF=/KOHA/%i/etc/koha-conf.xml
ExecStart=/KOHA/%i/bin/prosentient/mq_scheduler.pl -v
Restart=on-failure
RestartSec=5s
StartLimitBurst=3
StartLimitInterval=60
SyslogIdentifier=koha-mq-scheduler_%i

[Install]
WantedBy=multi-user.target




[% USE raw %]
[% USE Asset %]
[% SET footerjs = 1 %]
    [% INCLUDE 'doc-head-open.inc' %]
    <title>Koha &rsaquo; Tools &rsaquo; Authorities audit</title>
    [% INCLUDE 'doc-head-close.inc' %]
</head>

<body id="tools_quotes" class="tools">
[% INCLUDE 'header.inc' %]
[% INCLUDE 'cat-search.inc' %]

<div id="breadcrumbs"><a href="/cgi-bin/koha/mainpage.pl">Home</a> &rsaquo; <a href="/cgi-bin/koha/tools/tools-home.pl">Tools</a> &rsaquo; Authorities audit</div>

<div class="main container-fluid">
    <div class="row">
        <div class="col-sm-10 col-sm-push-2">
            <main>
                <h1>Authorities audit</h1>
                [% IF ( tags_to_audit ) %]
                <form method="post" action="/cgi-bin/koha/tools/prosentient/audit-authorities.pl">
                    <fieldset id="tags_to_audit" class="rows">
                        <legend>Select tag to audit</legend>
                        <ol>
                            <li>
                                <label for="taglist">Tags: </label>
                                <select id="taglist" name="tag">
                                [% FOREACH tag IN tags_to_audit %]
                                    <option value="[% tag.tagfield %][% tag.tagsubfield %][% tag.authtypecode %]">[% tag.tagfield %]$[% tag.tagsubfield %] - [% tag.authtypecode %]</option>
                                [% END %]
                                </select>
                            </li>
                        </ol>
                    </fieldset>
                    <fieldset id="footer" class="action">
                        <input type="submit" value="Audit" class="button">
                        <a class="cancel" href="/cgi-bin/koha/tools/tools-home.pl">Cancel</a>
                    </fieldset>
                </form>
                [% ELSIF ( audit ) %]
                [% IF ( message_enqueued ) %]
                    <p>The authorities audit may take a long time to run depending on the size of your authority file.</p>
                    <p>Your audit has been scheduled to run offline in batch mode. <strong>Please do not refresh or resubmit.</strong></p>
                    [% IF ( email ) %]
                        <p>When the audit is complete, a report will be emailed to "[% email %]".</p>
                    [% END %]
                [% ELSE %]
                    <p>Unable to schedule your authorities audit. Please contact your system administrator for assistance</p>
                [% END %]
                <fieldset id="audit" class="rows">
                    <legend>Audit details</legend>
                    <ol>
                        <li>
                            <label for="field">Field: </label>
                            <span id="field">[% field %]</span>
                        </li>
                        <li>
                            <label for="subfield">Subfield: </label>
                            <span id="subfield">[% subfield %]</span>
                        </li>
                        <li>
                            <label for="authtypcode">Authority type: </label>
                            <span id="authtypecode">[% authtypecode %]</span>
                        </li>
                    </ol>
                </fieldset>
                <fieldset id="footer" class="action">
                    <a class="new_audit" href="/cgi-bin/koha/tools/prosentient/audit-authorities.pl">New audit</a>
                </fieldset>
                [% END %]
            </main>
        </div> <!-- /.col-sm-10.col-sm-push-2 -->

        <div class="col-sm-2 col-sm-pull-10">
            <aside>
                [% INCLUDE 'tools-menu.inc' %]
            </aside>
        </div> <!-- /.col-sm-2.col-sm-pull-10 -->
     </div> <!-- /.row -->

[% MACRO jsinclude BLOCK %]
[% END %]

[% INCLUDE 'intranet-bottom.inc' %]




#!/usr/bin/perl
#
# Copyright Prosentient Systems 2020
#
# 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 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.
#
# 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.

use Modern::Perl;
use Getopt::Long;
use Pod::Usage;
use JSON;
use Module::Load::Conditional qw/can_load/;

use Koha::Prosentient::MQ;

=head1 SYNOPSIS

   pro_mq_worker.pl [-h|--help] [--man] 

=cut

#Make STDOUT hot so STDOUT logging doesn't suffer from buffering
$|++;

my ($help,$man,$verbose);

GetOptions(
    '-h|help'   => \$help,
    '--man'     => \$man,
    '-v'        => \$verbose,
) || pod2usage(2);

pod2usage(1) if $help;
pod2usage( -verbose => 2 ) if $man;

if ( Koha::Prosentient::MQ::is_supported() ){
    my $conn = Koha::Prosentient::MQ::connection();
    if ($conn){
        my $queues = Koha::Prosentient::MQ::queues();
        if (@$queues){
            foreach my $queue (@$queues){
                $conn->subscribe({
                    destination             => $queue->{dest},
                    'ack'                   => 'client',
                    'activemq.prefetchSize' => 1,
                });
            }
        }
        MSG: while (1){
            my $frame = $conn->receive_frame;
            if (! defined $frame){
                next MSG;
            }
            $verbose && print "Message received\n";
            my $body = $frame->body;
            if ($body){
                my $task = decode_json($body);
                if ( $task && $task->{class} && $task->{method} ){
                    my $class = $task->{class};
                    my $method = $task->{method};
                    my $args = $task->{args};
                    if ( can_load( modules => { $class => undef, } ) ){
                        my $completed = $class->$method($args);
                        if ($completed){
                            $conn->ack( { frame => $frame } );
                            $verbose && print "Message processed and task completed\n";
                            next MSG;
                        }
                    } else {
                        warn "Unable to load $class";
                    }
                }
            }
            #FIXME: This should be a 'nack' instead of an 'ack',
            #but we don't want the scheduler stuck in a loop trying
            #to process the same message over and over again, if it fails to 'ack'
            $conn->ack( { frame => $frame } );
            $verbose && print "Task failed but message acknowledged\n";
        }
    }
} else {
    warn "Prosentient Koha Messsage Queue not supported!";
    exit 1;
}





#!/usr/bin/perl

# Copyright 2020 Prosentient Systems
#
# 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 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.
#
# You should have received a copy of the GNU General Public License
# along with Koha; if not, see <http://www.gnu.org/licenses>.

use Modern::Perl;
use CGI qw ( -utf8 );
use JSON;

use C4::Auth;
use C4::Koha;
use C4::Context;
use C4::Output;

use Koha::MarcSubfieldStructures;
use Koha::Prosentient::MQ;

my $cgi = new CGI;
my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
    {
        template_name   => "tools/prosentient/audit-authorities.tt",
        query           => $cgi,
        type            => "intranet",
        authnotrequired => 0,
        flagsrequired => { tools => '*' },
        debug           => 1,
    }
);
my $tag = $cgi->param('tag');
if ( $tag && $tag =~ /([0-9a-zA-Z]{3})([0-9a-zA-Z%]{1})(.*)/ ){
    my $field = $1; #field should always be [0-9]{3} but 01e exists
    my $subfield = $2; #subfield should always be [0-9a-zA-Z] but % also exists
    my $authtypecode = $3;
    my $email;
    $template->param( audit => 1 );
    $template->param( field => $field );
    $template->param( subfield => $subfield );
    $template->param( authtypecode => $authtypecode );
    my $logged_in_user = Koha::Patrons->find( $borrowernumber );
    if ($logged_in_user){
        my $user_email = $logged_in_user->first_valid_email_address;
        if ( $user_email ){
            $email = $user_email;
            $template->param( email => $email );
        } else {
            my $branch_email = $logged_in_user->library->branchemail;
            if ($branch_email){
                $email = $branch_email;
                $template->param( email => $branch_email );
            }
        }
    }
    my $task = {
        class => 'Koha::Prosentient::MQ::AuditAuthorities',
        method => 'do_task',
        args => {
            field => $field,
            subfield => $subfield,
            authtypecode => $authtypecode,
            email => $email,
        }
    };
    my $msg = encode_json($task);

    my $queue = Koha::Prosentient::MQ::queue("auditauthorities");
    if ($queue){
        my $conn = Koha::Prosentient::MQ::connection();
        if ($conn){
            my $sent = $conn->send_with_receipt({
                destination => $queue,
                body => $msg,
            });
            if ($sent){
                $template->param( message_enqueued => 1 );
            }
        }
    }
}
else {
    my @tags_to_audit = Koha::MarcSubfieldStructures->search(
        {
            authtypecode => { '!=', '' },
        },
        {
            group_by => [qw/tagfield tagsubfield authtypecode/],
        }
    );
    if (@tags_to_audit){
        $template->param( tags_to_audit => \@tags_to_audit );
    }
}
output_html_with_http_headers $cgi, $cookie, $template->output;

Return to bug 22417

Line 0 Link Here

(-)a/Koha/Prosentient/MQ.pm (+79 lines)
		1	package Koha::Prosentient::MQ;
		2
		3	use Modern::Perl;
		4	use Module::Load::Conditional qw/check_install/;
		5	use C4::Context;
		6
		7	sub _get_config {
		8	my $config;
		9	my $context = C4::Context->new();
		10	if ($context && $context->{prosentient} && $context->{prosentient}->{message_broker}){
		11	$config = $context->{prosentient}->{message_broker};
		12	}
		13	return $config;
		14	}
		15
		16	sub is_supported {
		17	my $supported = 0;
		18	my $stomp_lib = check_install( module => 'Net::Stomp' );
		19	my $config = _get_config();
		20	if ($stomp_lib && $config){
		21	$supported = 1;
		22	}
		23	return $supported;
		24	}
		25
		26	sub queue {
		27	my ($queue_id) = @_;
		28	my $queue;
		29	if ( is_supported() ){
		30	my $config = _get_config();
		31	if ($config && $config->{queue} && $queue_id){
		32	my $queue_config = $config->{queue}->{$queue_id};
		33	if ($queue_config && $queue_config->{dest}){
		34	$queue = $queue_config->{dest};
		35	}
		36	}
		37	}
		38	return $queue;
		39	}
		40
		41	sub queues {
		42	my @queues = ();
		43	if ( is_supported() ){
		44	my $config = _get_config();
		45	if ($config){
		46	my $queue_hash = $config->{queue};
		47	foreach my $queue_id (keys %$queue_hash){
		48	my $queue_config = $queue_hash->{$queue_id};
		49	if ($queue_config && $queue_config->{dest}){
		50	my $queue = {
		51	id => $queue_id,
		52	dest => $queue_config->{dest},
		53	};
		54	push(@queues,$queue);
		55	}
		56	}
		57	}
		58	}
		59	return \@queues;
		60	}
		61
		62	sub connection {
		63	my $connection;
		64	if ( is_supported() ){
65	#NOTE: During the experimental phase, lazy load this library
66	require Net::Stomp;
67	my $config = _get_config();
68	if ($config){
69	my $stomp = Net::Stomp->new( { hostname => $config->{hostname}, port => $config->{port} } );
70	my $frame = $stomp->connect( { login => $config->{user}, passcode => $config->{password}, host => $config->{vhost} } );
71	if ($frame && $frame->command eq 'CONNECTED'){
72	$connection = $stomp;
73	}
74	}
75	}
76	return $connection;
77	}
78
79	1;

Line 0 Link Here

(-)a/Koha/Prosentient/MQ/AuditAuthorities.pm (+287 lines)
		1	package Koha::Prosentient::MQ::AuditAuthorities;
		2
		3	use Modern::Perl;
		4	use Template;
		5	use Mail::Sendmail;
		6	use Email::Valid;
		7	use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
		8	use Encode;
		9	use MIME::QuotedPrint;
		10	use MIME::Base64;
		11
		12	use C4::Context;
		13	use Koha::Database;
		14	use Koha::MarcSubfieldStructures;
		15	use Koha::Biblios;
		16
		17	my $email_template = <<EMAIL_TEMPLATE;
		18	<html>
		19	<head>
		20	<style type="text/css">
		21	table, tr, th, td {
		22	border-style: solid;
		23	}
		24	</style>
		25	</head>
		26	<body>
		27	<table>
		28	<tr>
		29	<th>Biblionumber</th>
		30	<th>Tag</th>
		31	<th>Auth type</th>
		32	<th>Bib heading</th>
		33	<th>Linkage in bib</th>
		34	<th>Description</th>
		35	<th>Matched authority id</th>
		36	<th>Matched authority heading</th>
		37	</tr>
		38	[% FOREACH result IN results %]
		39	<tr>
		40	<td>[% result.biblionumber %]</td>
		41	<td>[% result.field %]$[% result.subfield %]</td>
		42	<td>[% result.authtypecode %]</td>
		43	<td>[% result.bib_full %]</td>
		44	<td>[% result.linkage %]</td>
		45	<td>[% result.desc %]</td>
		46	<td>[% result.matched_id %]</td>
		47	<td>[% result.matched_heading %]</td>
		48	</tr>
		49	[% END %]
		50	</table>
		51	</body>
		52	</html>
		53	EMAIL_TEMPLATE
		54
		55	sub do_task {
		56	my ($class,$args) = @_;
		57	my $completed = 1;
		58	my $debug = $args->{debug} // 0;
		59	my $field = $args->{field};
		60	my $subfield = $args->{subfield};
		61	my $authtypecode = $args->{authtypecode};
		62	my $email = $args->{email};
		63	$debug && warn __PACKAGE__ . " " . "starting task";
		64	if ($field && $subfield && $authtypecode){
65	my $results = _get_results({
66	field => $field,
67	subfield => $subfield,
68	authtypecode => $authtypecode,
69	});
70	if (@$results){
71	$debug && warn __PACKAGE__ . " " . scalar @$results . " results";
72	my $report = _create_report({
73	results => $results,
74	});
75	if ($report){
76	$debug && warn __PACKAGE__ . " " . "report created";
77	my $sent = _email_report({
78	email => $email,
79	report => $report,
80	tag => $field . '$' . $subfield,
81	});
82	if ($sent){
83	$debug && warn __PACKAGE__ . " " . "email sent";
84	}
85	}
86	}
87	}
88	$debug && warn __PACKAGE__ . " " . "completed task";
89	return $completed;
90	}
91
92	sub _email_report {
93	my ($args) = @_;
94	my $sent;
95	my $email = $args->{email};
96	my $report = $args->{report};
97	my $tag = $args->{tag};
98	if ($email && $report && $tag){
99	if ( Email::Valid->address($email) ){
100	my $zip = Archive::Zip->new();
101	$zip->addString(Encode::encode("UTF-8",$report),"authorityreport_$tag.html");
102	my $memory_file = ''; #scalar as a file
103	open(my $fh, '>', \$memory_file);
104	my $status = $zip->writeToFileHandle($fh);
105	if ($status == AZ_OK){
106	$fh->close;
107	my $zipfile = encode_base64($memory_file);
108
109	my %mail = ();
110	$mail{from} = 'ADMIN@DOMAIN.com';
111	$mail{to} = $email;
112	$mail{subject} = Encode::encode("UTF-8","Authorities audit report for your catalogue on tag $tag");
113	my $boundary = "====" . time() . "====";
114	$mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
115	$boundary = '--' . $boundary;
116	my $body = encode_qp(Encode::encode("UTF-8","<html><body>Please find attached your authorities audit report for review.</body></html>"));
117	$mail{body} = <<END_OF_BODY;
118	$boundary
119	Content-Type: text/html; charset="utf-8"
120	Content-Transfer-Encoding: quoted-printable
121
122	$body
123	$boundary
124	Content-Type: application/octet-stream; name="authorityreport_$tag.zip"
125	Content-Transfer-Encoding: base64
126	Content-Disposition: attachment; filename="authorityreport_$tag.zip"
127
128	$zipfile
129	$boundary--
130	END_OF_BODY
131	if ( sendmail %mail ) {
132	$sent = 1;
133	}
134	}
135	}
136	}
137	return $sent;
138	}
139
140	sub _get_results {
141	my ($args) = @_;
142	my @results = ();
143	my $field = $args->{field};
144	my $subfield = $args->{subfield};
145	my $authtypecode = $args->{authtypecode};
146	if ($field && $subfield && $authtypecode){
147
148	my $schema = Koha::Database->new->schema;
149	my $authtype = $schema->resultset('AuthType')->search({
150	authtypecode => $authtypecode,
151	})->first;
152
153	my $auth_tag = $authtype->auth_tag_to_report;
154
155	my %auth_lookup_by_id = ();
156	my %auth_lookup_by_full = ();
157	my %auth_lookup_by_primary = ();
158	my $dbh = C4::Context->dbh;
159	my $sql = qq~
160	SELECT
161	authid,
162	ExtractValue(marcxml,'//datafield[\@tag="$auth_tag"]/*') as full_header,
163	ExtractValue(marcxml,'//datafield[\@tag="$auth_tag"]/subfield[\@code="a"]') as primary_header
164	FROM auth_header
165	WHERE authtypecode = ?
166	~;
167	my $sth = $dbh->prepare($sql);
168	$sth->execute($authtypecode);
169	while (my $row = $sth->fetchrow_hashref){
170	$auth_lookup_by_id{ $row->{authid} } = { full => $row->{full_header}, primary => $row->{primary_header}, };
171	if ( ! $auth_lookup_by_full{ $row->{full_header} } ){
172	$auth_lookup_by_full{ $row->{full_header} } = [];
173	}
174	push(@{$auth_lookup_by_full{ $row->{full_header} }},$row->{authid});
175
176	if ( ! $auth_lookup_by_primary{ $row->{primary_header} } ){
177	$auth_lookup_by_primary{ $row->{primary_header} }= [];
178	}
179	push(@{$auth_lookup_by_primary{ $row->{primary_header} }},$row->{authid});
180	}
181
182
183	my @frameworks_to_audit = Koha::MarcSubfieldStructures->search(
184	{
185	tagfield => $field,
186	tagsubfield => $subfield,
187	authtypecode => $authtypecode,
188	}
189	);
190	my @search_conditions = ();
191	foreach my $structure (@frameworks_to_audit){
192	my $frameworkcode = $structure->frameworkcode;
193	my $condition = { frameworkcode => $frameworkcode };
194	push(@search_conditions,$condition);
195	}
196
197
198
199	my @biblios = Koha::Biblios->search(\@search_conditions);
200	foreach my $biblio (@biblios){
201	my $record = $biblio->metadata->record;
202	if ($record){
203	my @marc_fields = $record->field($field);
204	foreach my $marc_field (@marc_fields){
205	my $result = {
206	biblionumber => $biblio->biblionumber,
207	field => $field,
208	subfield => $subfield,
209	bib_full => '',
210	authtypecode => $authtypecode,
211	linkage => '',
212	matched_heading => '',
213	matched_id => '',
214	desc => 'Unlinked and no match',
215	};
216	#Check if it already has a $9 linkage
217	my $bib_field = $marc_field->clone();
218	my $linkage = $bib_field->subfield('9');
219	$bib_field->delete_subfield('9');
220	my $bib_subfield = $bib_field->subfield($subfield);
221	my $bib_full = $bib_field->as_string;
222	$result->{bib_full} = $bib_full;
223	if ( $linkage){
224	my $linked_auth = $auth_lookup_by_id{ $linkage };
225	if ($linked_auth){
226	$result->{linkage} = $linkage;
227	if ( $linked_auth->{full} eq $bib_field->as_string){
228	$result->{desc} = "Linked heading 100% match";
229	$result->{matched_heading} = $linked_auth->{full};
230	} elsif ( $bib_subfield && $linked_auth->{primary} eq $bib_subfield ){
231	$result->{desc} = "Linked heading partial match";
232	$result->{matched_heading} = $linked_auth->{primary};
233
234	} else {
235	$result->{desc} = "Linked heading does not match";
236	$result->{matched_heading} = $linked_auth->{full};
237	}
238	} else {
239	$result->{desc} = "Linked but unable to find authority record";
240	}
241	} else {
242	my $full_match = $auth_lookup_by_full{ $bib_full };
243	if ($full_match) {
244	$result->{desc} = "Unlinked but found 100% match";
245	$result->{matched_id} = join(',',@$full_match);
246	$result->{matched__heading} = $bib_full;
247	} else {
248	if ($bib_subfield){
249	my $primary_match = $auth_lookup_by_primary{ $bib_subfield };
250	if ($primary_match){
251	$result->{desc} = "Unlinked but found partial match";
252	$result->{matched_id} = join(',',@$primary_match);
253	$result->{matched_heading} = $bib_subfield;
254	}
255	}
256	}
257	}
258	push(@results,$result);
259	}
260	}
261	}
262	}
263	return \@results;
264	}
265
266	1;
267
268	sub _get_template {
269	my $template;
270	while (my $line = <DATA>){
271	$template .= $line;
272	}
273	return $template;
274	}
275
276	sub _create_report {
277	my ($args) = @_;
278	my $report;
279	my $results = $args->{results};
280	if ($results){
281	my $template_engine = Template->new({ ENCODING => 'UTF-8', });
282	my $template = $email_template;
283	$template_engine->process(\$template, { results => $results, }, \$report);
284	}
285	return $report;
286	}
287

Line 0 Link Here

(-)a/etc/prosentient/koha-mq-scheduler@.service (+18 lines)
	1	# koha-mq-scheduler@.service
	2	# /etc/systemd/system/koha-mq-scheduler@.service
	3	[Unit]
	4	Description=Koha Message Queue Work Scheduler
	5	After=syslog.target network.target rabbitmq-server.service
	6
	7	[Service]
	8	Environment=PERL5LIB=/KOHA/%i/lib
	9	Environment=KOHA_CONF=/KOHA/%i/etc/koha-conf.xml
	10	ExecStart=/KOHA/%i/bin/prosentient/mq_scheduler.pl -v
	11	Restart=on-failure
	12	RestartSec=5s
	13	StartLimitBurst=3
	14	StartLimitInterval=60
	15	SyslogIdentifier=koha-mq-scheduler_%i
	16
	17	[Install]
	18	WantedBy=multi-user.target

Line 0 Link Here

(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/prosentient/audit-authorities.tt (+84 lines)
		1	[% USE raw %]
		2	[% USE Asset %]
		3	[% SET footerjs = 1 %]
		4	[% INCLUDE 'doc-head-open.inc' %]
		5	<title>Koha &rsaquo; Tools &rsaquo; Authorities audit</title>
		6	[% INCLUDE 'doc-head-close.inc' %]
		7	</head>
		8
		9	<body id="tools_quotes" class="tools">
		10	[% INCLUDE 'header.inc' %]
		11	[% INCLUDE 'cat-search.inc' %]
		12
		13	<div id="breadcrumbs"><a href="/cgi-bin/koha/mainpage.pl">Home</a> &rsaquo; <a href="/cgi-bin/koha/tools/tools-home.pl">Tools</a> &rsaquo; Authorities audit</div>
		14
		15	<div class="main container-fluid">
		16	<div class="row">
		17	<div class="col-sm-10 col-sm-push-2">
		18	<main>
		19	<h1>Authorities audit</h1>
		20	[% IF ( tags_to_audit ) %]
		21	<form method="post" action="/cgi-bin/koha/tools/prosentient/audit-authorities.pl">
		22	<fieldset id="tags_to_audit" class="rows">
		23	<legend>Select tag to audit</legend>
		24	<ol>
		25	<li>
		26	<label for="taglist">Tags: </label>
		27	<select id="taglist" name="tag">
		28	[% FOREACH tag IN tags_to_audit %]
		29	<option value="[% tag.tagfield %][% tag.tagsubfield %][% tag.authtypecode %]">[% tag.tagfield %]$[% tag.tagsubfield %] - [% tag.authtypecode %]</option>
		30	[% END %]
		31	</select>
		32	</li>
		33	</ol>
		34	</fieldset>
		35	<fieldset id="footer" class="action">
		36	<input type="submit" value="Audit" class="button">
		37	<a class="cancel" href="/cgi-bin/koha/tools/tools-home.pl">Cancel</a>
		38	</fieldset>
		39	</form>
		40	[% ELSIF ( audit ) %]
		41	[% IF ( message_enqueued ) %]
		42	<p>The authorities audit may take a long time to run depending on the size of your authority file.</p>
		43	<p>Your audit has been scheduled to run offline in batch mode. <strong>Please do not refresh or resubmit.</strong></p>
		44	[% IF ( email ) %]
		45	<p>When the audit is complete, a report will be emailed to "[% email %]".</p>
		46	[% END %]
		47	[% ELSE %]
		48	<p>Unable to schedule your authorities audit. Please contact your system administrator for assistance</p>
		49	[% END %]
		50	<fieldset id="audit" class="rows">
		51	<legend>Audit details</legend>
		52	<ol>
		53	<li>
		54	<label for="field">Field: </label>
		55	<span id="field">[% field %]</span>
		56	</li>
		57	<li>
		58	<label for="subfield">Subfield: </label>
		59	<span id="subfield">[% subfield %]</span>
		60	</li>
		61	<li>
		62	<label for="authtypcode">Authority type: </label>
		63	<span id="authtypecode">[% authtypecode %]</span>
		64	</li>
65	</ol>
66	</fieldset>
67	<fieldset id="footer" class="action">
68	<a class="new_audit" href="/cgi-bin/koha/tools/prosentient/audit-authorities.pl">New audit</a>
69	</fieldset>
70	[% END %]
71	</main>
72	</div> <!-- /.col-sm-10.col-sm-push-2 -->
73
74	<div class="col-sm-2 col-sm-pull-10">
75	<aside>
76	[% INCLUDE 'tools-menu.inc' %]
77	</aside>
78	</div> <!-- /.col-sm-2.col-sm-pull-10 -->
79	</div> <!-- /.row -->
80
81	[% MACRO jsinclude BLOCK %]
82	[% END %]
83
84	[% INCLUDE 'intranet-bottom.inc' %]

Line 0 Link Here

(-)a/misc/prosentient/mq_scheduler.pl (+97 lines)
		1	#!/usr/bin/perl
		2	#
		3	# Copyright Prosentient Systems 2020
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 3 of the License, or (at your option) any later
		10	# version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		15	#
		16	# You should have received a copy of the GNU General Public License along
		17	# with Koha; if not, write to the Free Software Foundation, Inc.,
		18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		19
		20	use Modern::Perl;
		21	use Getopt::Long;
		22	use Pod::Usage;
		23	use JSON;
		24	use Module::Load::Conditional qw/can_load/;
		25
		26	use Koha::Prosentient::MQ;
		27
		28	=head1 SYNOPSIS
		29
		30	pro_mq_worker.pl [-h\|--help] [--man]
		31
		32	=cut
		33
		34	#Make STDOUT hot so STDOUT logging doesn't suffer from buffering
		35	$\|++;
		36
		37	my ($help,$man,$verbose);
		38
		39	GetOptions(
		40	'-h\|help' => \$help,
		41	'--man' => \$man,
		42	'-v' => \$verbose,
		43	) \|\| pod2usage(2);
		44
		45	pod2usage(1) if $help;
		46	pod2usage( -verbose => 2 ) if $man;
		47
		48	if ( Koha::Prosentient::MQ::is_supported() ){
		49	my $conn = Koha::Prosentient::MQ::connection();
		50	if ($conn){
		51	my $queues = Koha::Prosentient::MQ::queues();
		52	if (@$queues){
		53	foreach my $queue (@$queues){
		54	$conn->subscribe({
		55	destination => $queue->{dest},
		56	'ack' => 'client',
		57	'activemq.prefetchSize' => 1,
		58	});
		59	}
		60	}
		61	MSG: while (1){
		62	my $frame = $conn->receive_frame;
		63	if (! defined $frame){
		64	next MSG;
65	}
66	$verbose && print "Message received\n";
67	my $body = $frame->body;
68	if ($body){
69	my $task = decode_json($body);
70	if ( $task && $task->{class} && $task->{method} ){
71	my $class = $task->{class};
72	my $method = $task->{method};
73	my $args = $task->{args};
74	if ( can_load( modules => { $class => undef, } ) ){
75	my $completed = $class->$method($args);
76	if ($completed){
77	$conn->ack( { frame => $frame } );
78	$verbose && print "Message processed and task completed\n";
79	next MSG;
80	}
81	} else {
82	warn "Unable to load $class";
83	}
84	}
85	}
86	#FIXME: This should be a 'nack' instead of an 'ack',
87	#but we don't want the scheduler stuck in a loop trying
88	#to process the same message over and over again, if it fails to 'ack'
89	$conn->ack( { frame => $frame } );
90	$verbose && print "Task failed but message acknowledged\n";
91	}
92	}
93	} else {
94	warn "Prosentient Koha Messsage Queue not supported!";
95	exit 1;
96	}
97

Line 0 Link Here

(-)a/tools/prosentient/audit-authorities.pl (-1 / +106 lines)
0	-	1	#!/usr/bin/perl
		2
		3	# Copyright 2020 Prosentient Systems
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it
		8	# under the terms of the GNU General Public License as published by
		9	# the Free Software Foundation; either version 3 of the License, or
		10	# (at your option) any later version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but
		13	# WITHOUT ANY WARRANTY; without even the implied warranty of
		14	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		15	# GNU General Public License for more details.
		16	#
		17	# You should have received a copy of the GNU General Public License
		18	# along with Koha; if not, see <http://www.gnu.org/licenses>.
		19
		20	use Modern::Perl;
		21	use CGI qw ( -utf8 );
		22	use JSON;
		23
		24	use C4::Auth;
		25	use C4::Koha;
		26	use C4::Context;
		27	use C4::Output;
		28
		29	use Koha::MarcSubfieldStructures;
		30	use Koha::Prosentient::MQ;
		31
		32	my $cgi = new CGI;
		33	my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
		34	{
		35	template_name => "tools/prosentient/audit-authorities.tt",
		36	query => $cgi,
		37	type => "intranet",
		38	authnotrequired => 0,
		39	flagsrequired => { tools => '*' },
		40	debug => 1,
		41	}
		42	);
		43	my $tag = $cgi->param('tag');
		44	if ( $tag && $tag =~ /([0-9a-zA-Z]{3})([0-9a-zA-Z%]{1})(.*)/ ){
		45	my $field = $1; #field should always be [0-9]{3} but 01e exists
		46	my $subfield = $2; #subfield should always be [0-9a-zA-Z] but % also exists
		47	my $authtypecode = $3;
		48	my $email;
		49	$template->param( audit => 1 );
		50	$template->param( field => $field );
		51	$template->param( subfield => $subfield );
		52	$template->param( authtypecode => $authtypecode );
		53	my $logged_in_user = Koha::Patrons->find( $borrowernumber );
		54	if ($logged_in_user){
		55	my $user_email = $logged_in_user->first_valid_email_address;
		56	if ( $user_email ){
		57	$email = $user_email;
		58	$template->param( email => $email );
		59	} else {
		60	my $branch_email = $logged_in_user->library->branchemail;
		61	if ($branch_email){
		62	$email = $branch_email;
		63	$template->param( email => $branch_email );
		64	}
		65	}
66	}
67	my $task = {
68	class => 'Koha::Prosentient::MQ::AuditAuthorities',
69	method => 'do_task',
70	args => {
71	field => $field,
72	subfield => $subfield,
73	authtypecode => $authtypecode,
74	email => $email,
75	}
76	};
77	my $msg = encode_json($task);
78
79	my $queue = Koha::Prosentient::MQ::queue("auditauthorities");
80	if ($queue){
81	my $conn = Koha::Prosentient::MQ::connection();
82	if ($conn){
83	my $sent = $conn->send_with_receipt({
84	destination => $queue,
85	body => $msg,
86	});
87	if ($sent){
88	$template->param( message_enqueued => 1 );
89	}
90	}
91	}
92	}
93	else {
94	my @tags_to_audit = Koha::MarcSubfieldStructures->search(
95	{
96	authtypecode => { '!=', '' },
97	},
98	{
99	group_by => [qw/tagfield tagsubfield authtypecode/],
100	}
101	);
102	if (@tags_to_audit){
103	$template->param( tags_to_audit => \@tags_to_audit );
104	}
105	}
106	output_html_with_http_headers $cgi, $cookie, $template->output;