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

Return to bug 21865