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

(-)a/misc/migration_tools/remove_unused_authorities.pl (-22 / +32 lines)
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
- 

Return to bug 21865