Lines 18-93
Link Here
|
18 |
use Modern::Perl; |
18 |
use Modern::Perl; |
19 |
|
19 |
|
20 |
use Getopt::Long qw( GetOptions ); |
20 |
use Getopt::Long qw( GetOptions ); |
21 |
use Pod::Usage qw( pod2usage ); |
21 |
use Pod::Usage qw( pod2usage ); |
22 |
|
22 |
|
23 |
use Koha::Script -cron; |
23 |
use Koha::Script -cron; |
24 |
|
24 |
use C4::Biblio qw( DelBiblio ); |
25 |
use C4::Context; |
|
|
26 |
use Koha::Items; |
25 |
use Koha::Items; |
27 |
|
26 |
|
28 |
my $dbh = C4::Context->dbh(); |
27 |
my @where = (); |
29 |
|
28 |
my $verbose = 0; |
30 |
my $query = { |
29 |
my $help = 0; |
31 |
target_items => q|SELECT itemnumber, biblionumber from items| |
30 |
my $manual = 0; |
32 |
}; |
31 |
my $commit = 0; |
33 |
|
32 |
my $delete_biblios = 0; |
34 |
my $GLOBAL = { |
|
|
35 |
query => $query |
36 |
, sth => {} |
37 |
}; |
38 |
|
39 |
my $OPTIONS = { |
40 |
where => [] |
41 |
, flags => { |
42 |
verbose => '' |
43 |
, commit => '' |
44 |
, help => '' |
45 |
, manual => '' |
46 |
, version => '' |
47 |
} |
48 |
}; |
49 |
|
33 |
|
50 |
GetOptions( |
34 |
GetOptions( |
51 |
'where=s' => $OPTIONS->{where} |
35 |
'where=s' => \@where, 'v|verbose' => \$verbose, |
52 |
, 'v|verbose' => sub { $OPTIONS->{flags}->{verbose} = 1 } |
36 |
'h|help' => \$help, |
53 |
, 'V|version' => sub { $OPTIONS->{flags}->{version} = 1 } |
37 |
'm|manual' => \$manual, |
54 |
, 'h|help' => sub { $OPTIONS->{flags}->{help} = 1 } |
38 |
'c|commit' => \$commit, |
55 |
, 'm|manual' => sub { $OPTIONS->{flags}->{manual} = 1 } |
39 |
'del_bibs' => \$delete_biblios |
56 |
, 'c|commit' => sub { $OPTIONS->{flags}->{commit} = 1 } # aka DO-EET! |
|
|
57 |
); |
40 |
); |
58 |
|
41 |
|
59 |
my @where = @{ $OPTIONS->{where} }; |
42 |
pod2usage( -verbose => 2 ) if $manual; |
|
|
43 |
pod2usage( -verbose => 1 ) if $help; |
44 |
pod2usage( -verbose => 1, -message => 'You must supply at least one --where option' ) if scalar @where == 0; |
60 |
|
45 |
|
61 |
pod2usage( -verbose => 2 ) if $OPTIONS->{flags}->{manual}; |
46 |
my $where_clause = join( " AND ", @where ); |
62 |
pod2usage( -verbose => 1 ) if $OPTIONS->{flags}->{help}; |
|
|
63 |
pod2usage( -verbose => 1 -msg => 'You must supply at least one --where option' ) if scalar @where == 0; |
64 |
|
47 |
|
65 |
sub verbose { |
48 |
$verbose && say "Where statement: $where_clause"; |
66 |
say @_ if $OPTIONS->{flags}->{verbose}; |
49 |
if ($delete_biblios) { |
|
|
50 |
$verbose && say "Deleting bibliographic records when all items are deleted!"; |
67 |
} |
51 |
} |
68 |
|
52 |
|
69 |
my $where_clause = ' where ' . join ( " and ", @where ); |
53 |
print "Test run only! No data will be deleted.\n" unless $commit; |
|
|
54 |
my $deleted_string = $commit ? "Deleted" : "Would have deleted"; |
70 |
|
55 |
|
71 |
verbose "Where statement: $where_clause"; |
56 |
my $items = Koha::Items->search( \$where_clause ); |
72 |
|
57 |
|
73 |
# FIXME Use Koha::Items instead |
58 |
DELITEM: while ( my $item = $items->next ){ |
74 |
$GLOBAL->{sth}->{target_items} = $dbh->prepare( $query->{target_items} . $where_clause ); |
|
|
75 |
$GLOBAL->{sth}->{target_items}->execute(); |
76 |
|
59 |
|
77 |
DELITEM: while ( my $item = $GLOBAL->{sth}->{target_items}->fetchrow_hashref() ) { |
60 |
my $safe_to_delete = $item->safe_to_delete; |
|
|
61 |
if ($safe_to_delete) { |
62 |
my $holdings_count = $item->biblio->items->count - 1; |
63 |
$item->safe_delete |
64 |
if $commit; |
65 |
$verbose && say "$deleted_string item " . $item->itemnumber . " ($holdings_count items remain on record)"; |
78 |
|
66 |
|
79 |
my $item_object = Koha::Items->find($item->{itemnumber}); |
67 |
if ( $delete_biblios && $holdings_count == 0 ) { # aka DO-EET for empty bibs! |
80 |
my $safe_to_delete = $item_object->safe_to_delete; |
68 |
my $error = &DelBiblio( $item->biblionumber ) if $commit; |
81 |
if( $safe_to_delete ) { |
69 |
if ($error) { |
82 |
$item_object->safe_delete |
70 |
$verbose && say "Could not delete bib " . $item->biblionumber . ": $error"; |
83 |
if $OPTIONS->{flags}->{commit}; |
71 |
} else { |
84 |
verbose "Deleting '$item->{itemnumber}'"; |
72 |
$verbose && say "No items remaining. $deleted_string bibliographic record " . $item->biblionumber; |
|
|
73 |
} |
74 |
} |
85 |
} else { |
75 |
} else { |
86 |
verbose sprintf "Item '%s' (Barcode: '%s', Title: '%s') not deleted: %s", |
76 |
say sprintf( |
87 |
$item->{itemnumber}, |
77 |
"Item '%s' (Barcode: '%s', Title: '%s') cannot deleted: %s", |
88 |
$item_object->barcode, |
78 |
$item->itemnumber, |
89 |
$item_object->biblio->title, |
79 |
$item->barcode, |
90 |
@{$safe_to_delete->messages}[0]->message; |
80 |
$item->biblio->title, |
|
|
81 |
@{ $safe_to_delete->messages }[0]->message |
82 |
) if $verbose; |
91 |
} |
83 |
} |
92 |
} |
84 |
} |
93 |
|
85 |
|
Lines 130-140
clause querying the items table. These are joined by C<AND>.
Link Here
|
130 |
|
122 |
|
131 |
No items will be deleted unless the C<--commit> flag is present. |
123 |
No items will be deleted unless the C<--commit> flag is present. |
132 |
|
124 |
|
|
|
125 |
=item B<--del_bibs> |
126 |
|
127 |
Deletes the bibliographic record if the last item is deleted. |
128 |
|
133 |
=back |
129 |
=back |
134 |
|
130 |
|
135 |
=cut |
131 |
=cut |
136 |
|
132 |
|
137 |
|
|
|
138 |
=head1 EXAMPLES |
133 |
=head1 EXAMPLES |
139 |
|
134 |
|
140 |
The following is an example of this script: |
135 |
The following is an example of this script: |
Lines 145-158
No items will be deleted unless the C<--commit> flag is present.
Link Here
|
145 |
|
140 |
|
146 |
=cut |
141 |
=cut |
147 |
|
142 |
|
148 |
|
|
|
149 |
=head1 DESCRIPTION |
143 |
=head1 DESCRIPTION |
150 |
|
144 |
|
151 |
This is a lightweight batch deletion tool for items, suitable for running in a cron job. |
145 |
This is a lightweight batch deletion tool for items, suitable for running in a cron job. |
152 |
|
146 |
|
153 |
=cut |
147 |
=cut |
154 |
|
148 |
|
155 |
|
|
|
156 |
=head1 AUTHOR |
149 |
=head1 AUTHOR |
157 |
|
150 |
|
158 |
Barton Chittenden <barton@bywatersolutions.com> |
151 |
Barton Chittenden <barton@bywatersolutions.com> |
159 |
- |
|
|