|
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 |
- |
|
|