Lines 20-27
Link Here
|
20 |
# You should have received a copy of the GNU General Public License |
20 |
# You should have received a copy of the GNU General Public License |
21 |
# along with Koha; if not, see <http://www.gnu.org/licenses>. |
21 |
# along with Koha; if not, see <http://www.gnu.org/licenses>. |
22 |
|
22 |
|
23 |
use strict; |
23 |
use Modern::Perl; |
24 |
use warnings; |
|
|
25 |
|
24 |
|
26 |
use C4::Context; |
25 |
use C4::Context; |
27 |
use C4::AuthoritiesMarc; |
26 |
use C4::AuthoritiesMarc; |
Lines 42-96
if ($want_help) {
Link Here
|
42 |
print_usage(); |
41 |
print_usage(); |
43 |
exit 0; |
42 |
exit 0; |
44 |
} |
43 |
} |
45 |
|
|
|
46 |
if ($test) { |
44 |
if ($test) { |
47 |
print "testing only, authorities will not be deleted.\n"; |
45 |
print "*** Testing only, authorities will not be deleted. ***\n"; |
|
|
46 |
} |
47 |
if (@authtypes) { |
48 |
print "Restricted to authority type(s) : ".join(',', @authtypes).".\n"; |
48 |
} |
49 |
} |
49 |
|
50 |
|
50 |
my $errZebraConnection = C4::Context->Zconn("biblioserver",0)->errcode(); |
51 |
my $errZebraConnection = C4::Context->Zconn("biblioserver",0)->errcode(); |
51 |
if ( $errZebraConnection == 10000 ) { |
52 |
if ( $errZebraConnection == 10000 ) { |
52 |
die "Zebra server seems not to be available. This script needs Zebra runs." |
53 |
die "Zebra server seems not to be available. This script needs Zebra runs."; |
53 |
} elsif ( $errZebraConnection ) { |
54 |
} elsif ( $errZebraConnection ) { |
54 |
die "Error from Zebra: $errZebraConnection"; |
55 |
die "Error from Zebra: $errZebraConnection"; |
55 |
} |
56 |
} |
56 |
|
57 |
|
57 |
my $dbh=C4::Context->dbh; |
58 |
my $dbh=C4::Context->dbh; |
58 |
my $thresholdmin=0; |
|
|
59 |
my $thresholdmax=0; |
60 |
my @results; |
59 |
my @results; |
61 |
# prepare the request to retrieve all authorities of the requested types |
60 |
# prepare the request to retrieve all authorities of the requested types |
62 |
my $rqsql = "SELECT * from auth_header where 1"; |
61 |
my $rqsql = q{ SELECT authid,authtypecode FROM auth_header }; |
63 |
$rqsql .= " AND authtypecode IN (".join(",",map{$dbh->quote($_)}@authtypes).")" if @authtypes; |
62 |
$rqsql .= q{ WHERE authtypecode IN (}.join(',',map{ '?' }@authtypes).')' if @authtypes; |
64 |
my $rqselect = $dbh->prepare($rqsql); |
63 |
my $rqselect = $dbh->prepare($rqsql); |
65 |
$|=1; |
64 |
$|=1; |
66 |
|
65 |
|
67 |
$rqselect->execute; |
66 |
$rqselect->execute(@authtypes); |
68 |
my $counter=0; |
67 |
my $counter=0; |
69 |
my $totdeleted=0; |
68 |
my $totdeleted=0; |
70 |
my $totundeleted=0; |
69 |
my $totundeleted=0; |
71 |
my $searcher = Koha::SearchEngine::Search->new({index => 'biblios'}); |
70 |
my $searcher = Koha::SearchEngine::Search->new({index => 'biblios'}); |
72 |
while (my $data=$rqselect->fetchrow_hashref){ |
71 |
while (my $data=$rqselect->fetchrow_hashref){ |
73 |
my $query; |
72 |
$counter++; |
74 |
$query= "an=".$data->{'authid'}; |
73 |
print 'authid='.$data->{'authid'}; |
|
|
74 |
print ' type='.$data->{'authtypecode'}; |
75 |
my $bibliosearch = 'an:'.$data->{'authid'}; |
75 |
# search for biblios mapped |
76 |
# search for biblios mapped |
76 |
my ($err,$res,$used) = $searcher->simple_search_compat($query,0,10); |
77 |
my ($err,$res,$used) = $searcher->simple_search_compat($bibliosearch,0,10); |
77 |
if (defined $err) { |
78 |
if (defined $err) { |
78 |
warn "error: $err on search $query\n"; |
79 |
print "\n"; |
|
|
80 |
warn "Error: $err on search for biblios $bibliosearch\n"; |
79 |
next; |
81 |
next; |
80 |
} |
82 |
} |
81 |
print "."; |
83 |
unless ($used > 0){ |
82 |
print "$counter\n" unless $counter++ % 100; |
84 |
unless ($test) { |
83 |
# if found, delete, otherwise, just count |
85 |
DelAuthority({ authid => $data->{'authid'} }); |
84 |
if ($used>=$thresholdmin and $used<=$thresholdmax){ |
86 |
print " : deleted"; |
85 |
DelAuthority({ authid => $data->{'authid'} }) unless $test; |
87 |
} else { |
|
|
88 |
print " : can be deleted"; |
89 |
} |
86 |
$totdeleted++; |
90 |
$totdeleted++; |
87 |
} else { |
91 |
} else { |
88 |
$totundeleted++; |
92 |
$totundeleted++; |
|
|
93 |
print " : used $used time(s)"; |
89 |
} |
94 |
} |
|
|
95 |
print "\n"; |
90 |
} |
96 |
} |
91 |
|
97 |
|
92 |
print "$counter authorities parsed, $totdeleted deleted and $totundeleted unchanged because used\n"; |
98 |
print "$counter authorities parsed\n"; |
93 |
|
99 |
unless ($test) { |
|
|
100 |
print "$totdeleted deleted because unused\n"; |
101 |
} else { |
102 |
print "$totdeleted can be deleted because unused\n"; |
103 |
} |
104 |
print "$totundeleted unchanged because used\n"; |
94 |
|
105 |
|
95 |
sub print_usage { |
106 |
sub print_usage { |
96 |
print <<_USAGE_; |
107 |
print <<_USAGE_; |
97 |
- |
|
|