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

(-)a/cpanfile (+1 lines)
Lines 145-150 recommends 'HTTPD::Bench::ApacheBench', '0.73'; Link Here
145
recommends 'LWP::Protocol::https', '5.836';
145
recommends 'LWP::Protocol::https', '5.836';
146
recommends 'Lingua::Ispell', '0.07';
146
recommends 'Lingua::Ispell', '0.07';
147
recommends 'Locale::XGettext::TT2', '0.6';
147
recommends 'Locale::XGettext::TT2', '0.6';
148
recommends 'MARC::Lint', '1.50';
148
recommends 'Module::Bundled::Files', '0.03';
149
recommends 'Module::Bundled::Files', '0.03';
149
recommends 'Module::Load::Conditional', '0.38';
150
recommends 'Module::Load::Conditional', '0.38';
150
recommends 'Module::Pluggable', '3.9';
151
recommends 'Module::Pluggable', '3.9';
(-)a/debian/control (+2 lines)
Lines 83-88 Build-Depends: libalgorithm-checkdigits-perl, Link Here
83
 liblwp-protocol-https-perl | libwww-perl (<<6.02), libio-socket-ssl-perl,
83
 liblwp-protocol-https-perl | libwww-perl (<<6.02), libio-socket-ssl-perl,
84
 libmarc-charset-perl,
84
 libmarc-charset-perl,
85
 libmarc-file-mij-perl,
85
 libmarc-file-mij-perl,
86
 libmarc-lint-perl,
86
 libmarc-record-perl,
87
 libmarc-record-perl,
87
 libmarc-xml-perl,
88
 libmarc-xml-perl,
88
 libmime-lite-perl,
89
 libmime-lite-perl,
Lines 319-324 Depends: libalgorithm-checkdigits-perl, Link Here
319
 liblwp-protocol-https-perl | libwww-perl (<<6.02), libio-socket-ssl-perl,
320
 liblwp-protocol-https-perl | libwww-perl (<<6.02), libio-socket-ssl-perl,
320
 libmarc-charset-perl,
321
 libmarc-charset-perl,
321
 libmarc-file-mij-perl,
322
 libmarc-file-mij-perl,
323
 libmarc-lint-perl,
322
 libmarc-record-perl,
324
 libmarc-record-perl,
323
 libmarc-xml-perl,
325
 libmarc-xml-perl,
324
 libmime-lite-perl,
326
 libmime-lite-perl,
(-)a/misc/cronjobs/check_marc_errors.pl (-1 / +123 lines)
Line 0 Link Here
0
- 
1
#! /usr/bin/perl
2
#
3
# Copyright 2022 Aleisha Amohia <aleisha@catalyst.net.nz>
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
=head1 NAME
21
22
check_marc_errors.pl - Check for MARC encoding errors in bibliographic records and print results
23
24
=head1 USAGE
25
26
=over
27
28
=item check_marc_errors.pl [ --bibnum X ][ --intranet https://koha-intranet-url.com/ ]
29
30
=back
31
32
=cut
33
34
=head1 OPTIONS
35
36
=over
37
38
=item B<--bibnum X>
39
40
Check a specified biblio for MARC errors. Can be repeated to use with multiple biblios.
41
42
    --bibnum 1 --bibnum 2 --bibnum 3
43
44
=item B<--intranet https://koha-intranet-url.com/>
45
46
URL for Koha staff client. Required for the results to print a handy link to the record with the warning. Must include a trailing slash and a complete URL.
47
48
=back
49
50
=cut
51
52
use C4::Context;
53
use C4::Biblio qw( GetMarcBiblio );
54
use Getopt::Long qw( GetOptions );
55
use Modern::Perl;
56
use MARC::Lint;
57
use Koha::Biblios;
58
59
my @bibnum;
60
my $intranet;
61
62
GetOptions(
63
    '+bibnum=i'     => \@bibnum,
64
    'intranet=s'    => \$intranet,
65
);
66
67
my $count = 0;
68
69
print "<html>\n<body>\n<div id=\"marc_errors\">\n<table>";
70
71
# checking MARC errors for specific records only
72
if ( @bibnum ) {
73
    foreach my $id ( @bibnum ) {
74
        my $record = GetMarcBiblio({ biblionumber => $id });
75
76
        my $warning = lint_record( $record );
77
        my $detail_uri = "cgi-bin/koha/catalogue/detail.pl?biblionumber=";
78
        report( $id, $warning, $detail_uri );
79
    }
80
} else {
81
    # checking MARC errors for all records
82
    my $dbh = C4::Context->dbh;
83
    my $sth = $dbh->prepare("SELECT biblionumber FROM biblio");
84
    $sth->execute();
85
    my $warnings;
86
    while ( my ( $biblionumber ) = $sth->fetchrow ) {
87
        my $record = GetMarcBiblio({ biblionumber => $biblionumber });
88
89
        my $warning = lint_record( $record );
90
        my $detail_uri = "cgi-bin/koha/catalogue/detail.pl?biblionumber=";
91
        report( $biblionumber, $warning, $detail_uri );
92
    }
93
}
94
95
print "</table>\n</div>\n</body>\n</html>";
96
97
sub lint_record {
98
    my $record = shift;
99
    my $linter = MARC::Lint->new;
100
    $linter->check_record( $record );
101
    my $warnings = join( "\n", $linter->warnings );
102
    return $warnings;
103
}
104
105
sub report {
106
    my ( $id, $warning, $detail_uri ) = @_;
107
    if ( $warning ) {
108
        my $string = "<tr>\n";
109
        $count++;
110
        $string .= "<td>" . $count . "</td>\n";
111
        if ( $intranet ) {
112
            $string .= "<td><a href=\""
113
                    .  $intranet
114
                    .  $detail_uri
115
                    .  $id
116
                    .  "\">$id</a></td>\n";
117
        } else {
118
            $string .= "<td>" . $id . "</td>\n";
119
        }
120
        $string .= "<td>" . $warning . "</td>\n</tr>\n";
121
        print $string;
122
    }
123
}

Return to bug 30326