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

(-)a/misc/add_date_fields_to_marc_records.pl (-1 / +128 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it
6
# under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 3 of the License, or
8
# (at your option) any later version.
9
#
10
# Koha is distributed in the hope that it will be useful, but
11
# WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License
16
# along with Koha; if not, see <http://www.gnu.org/licenses>.
17
18
use Modern::Perl;
19
20
BEGIN {
21
    use FindBin;
22
    eval { require "$FindBin::Bin/../kohalib.pl" };
23
}
24
25
use Getopt::Long;
26
use Pod::Usage;
27
use MARC::Field;
28
29
use C4::Biblio;
30
use Koha::DateUtils qw( dt_from_string );
31
32
my ( $verbose, $help, $confirm, $where, @fields );
33
my $dbh = C4::Context->dbh;
34
35
GetOptions(
36
    'help|h'    => \$help,
37
    'verbose|v' => \$verbose,
38
    'confirm|c' => \$confirm,
39
    'where=s'   => \$where,
40
    'field=s@'  => \@fields,
41
) || podusage(1);
42
43
pod2usage(0) if $help;
44
45
my @fields_to_add;
46
my $dt = dt_from_string;    # Could be an option of the script
47
for my $field (@fields) {
48
    my ( $f_sf, $value )    = split '=',  $field;
49
    my ( $tag,  $subfield ) = split '\$', $f_sf;
50
    push @fields_to_add,
51
      MARC::Field->new( $tag, '', '', $subfield => $dt->strftime($value) );
52
}
53
54
say "Confirm flag not passed, running in dry-run mode...";
55
if ($verbose) {
56
    say "The following MARC fields will be added:";
57
    say "\t" . $_->as_formatted for @fields_to_add;
58
}
59
60
$where ||= "";
61
my $sth =
62
  $dbh->prepare("SELECT biblionumber, frameworkcode FROM biblio $where");
63
$sth->execute();
64
65
while ( my ( $biblionumber, $frameworkcode ) = $sth->fetchrow_array ) {
66
    my $marc_record =
67
      C4::Biblio::GetMarcBiblio( { biblionumber => $biblionumber } );
68
    next unless $marc_record;
69
    $marc_record->append_fields(@fields_to_add);
70
    if ($confirm) {
71
        my $modified =
72
          C4::Biblio::ModBiblio( $marc_record, $biblionumber, $frameworkcode );
73
        say "Bibliographic record $biblionumber has been modified"
74
          if $verbose and $modified;
75
    }
76
    elsif ($verbose) {
77
        say "Bibliographic record $biblionumber would have been modified";
78
    }
79
}
80
81
=head1 NAME
82
83
add_date_fields_to_marc_records.pl
84
85
=head1 SYNOPSIS
86
87
  perl add_date_fields_to_marc_records.pl --help
88
89
  perl add_date_fields_to_marc_records.pl --field='905$a=0/%Y' --field='905$a=1/%Y/%b-%m' --field='905$a=2/%Y/%b-%m/%d' --verbose --confirm
90
91
=head1 DESCRIPTION
92
93
Add some MARC fields to bibliographic records.
94
95
The replacement tokens are the ones used by strftime.
96
97
=over 8
98
99
=item B<--help>
100
101
Prints this help
102
103
=item B<--verbose>
104
105
Verbose mode.
106
107
=item B<--confirm>
108
109
Confirmation flag, the script will be running in dry-run mode if set not.
110
=item B<--where>
111
112
Limits the search on bibliographic records with a user-specified WHERE clause.
113
114
=item B<--field>
115
116
Fields to add to the bibliographic records.
117
118
Must be formatted as 'tag' $ 'subfield' = 'value'
119
120
For instance:
121
122
905$a=0/%Y will add a new field 905$a with the value '0/2019' (if run in 2019)
123
124
905$a=2/%Y/%b-%m/%d'will a a new field 905$a with the value '2/2019/Mar-03/13' if run on March 13th 2019
125
126
=back
127
128
=cut

Return to bug 22509