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