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

(-)a/C4/Koha.pm (-1 / +1 lines)
Lines 1515-1521 sub _isbn_cleanup { Link Here
1515
sub Log {
1515
sub Log {
1516
  my ($data) = @_;
1516
  my ($data) = @_;
1517
  warn $data;
1517
  warn $data;
1518
  open my $fh, '>>/tmp/koha.log';
1518
  open my $fh, '>>', '/tmp/koha.log';
1519
  print $fh "$data\n";
1519
  print $fh "$data\n";
1520
  close $fh;
1520
  close $fh;
1521
}
1521
}
(-)a/Koha/SimpleMARC.pm (-46 / +5 lines)
Lines 114-129 sub update_field { Link Here
114
114
115
  if ( ! ( $record && $fieldName ) ) { return; }
115
  if ( ! ( $record && $fieldName ) ) { return; }
116
116
117
  if ( @values eq 1 ) {
118
    _update_repeatable_field_with_single_value( $record, $fieldName, $subfieldName, @values );
119
    return;
120
  }
121
122
  my $i = 0;
117
  my $i = 0;
123
  my $field;
118
  my $field;
124
  if ( $subfieldName ) {
119
  if ( $subfieldName ) {
125
    if ( my @fields = $record->field( $fieldName ) ) {
120
    if ( my @fields = $record->field( $fieldName ) ) {
126
      unless ( $dont_erase ) {
121
      unless ( $dont_erase ) {
122
        @values = ($values[0]) x scalar( @fields )
123
          if @values == 1;
127
        foreach my $field ( @fields ) {
124
        foreach my $field ( @fields ) {
128
          $field->update( "$subfieldName" => $values[$i++] );
125
          $field->update( "$subfieldName" => $values[$i++] );
129
        }
126
        }
Lines 144-149 sub update_field { Link Here
144
    }
141
    }
145
  } else { ## No subfield
142
  } else { ## No subfield
146
    if ( my @fields = $record->field( $fieldName ) ) {
143
    if ( my @fields = $record->field( $fieldName ) ) {
144
      @values = ($values[0]) x scalar( @fields )
145
        if @values == 1;
147
      foreach my $field ( @fields ) {
146
      foreach my $field ( @fields ) {
148
        $field->update( $values[$i++] );
147
        $field->update( $values[$i++] );
149
      }
148
      }
Lines 262-268 sub field_equals { Link Here
262
sub move_field {
261
sub move_field {
263
  my ( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n ) = @_;
262
  my ( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n ) = @_;
264
  C4::Koha::Log( "C4::SimpleMARC::move_field( '$record', '$fromFieldName', '$fromSubfieldName', '$toFieldName', '$toSubfieldName', '$regex', '$n' )" ) if $debug;
263
  C4::Koha::Log( "C4::SimpleMARC::move_field( '$record', '$fromFieldName', '$fromSubfieldName', '$toFieldName', '$toSubfieldName', '$regex', '$n' )" ) if $debug;
265
  copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n , 1);
264
  copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n , 'dont_erase' );
266
  delete_field( $record, $fromFieldName, $fromSubfieldName, $n );
265
  delete_field( $record, $fromFieldName, $fromSubfieldName, $n );
267
}
266
}
268
267
Lines 296-340 sub delete_field { Link Here
296
  }
295
  }
297
}
296
}
298
297
299
=head2 _update_repeatable_field_with_single_value
300
301
  _update_repeatable_field_with_single_value( $record, $fieldName, $subfieldName, $value );
302
303
  Updates a repeatable field, giving all existing copies of that field the given value.
304
305
  This is an internal function, and thus is not exported.
306
307
=cut
308
309
sub _update_repeatable_field_with_single_value {
310
  my ( $record, $fieldName, $subfieldName, $value ) = @_;
311
  C4::Koha::Log( "C4::SimpleMARC::_update_repeatable_field_with_single_value( $record, $fieldName, $subfieldName, $value )" ) if $debug;
312
313
  if ( ! ( $record && $fieldName ) ) { return; }
314
315
  my $field;
316
  if ( $subfieldName ) {
317
    if ( my @fields = $record->field( $fieldName ) ) {
318
      foreach my $field ( @fields ) {
319
        $field->update( $subfieldName => $value );
320
      }
321
    } else {
322
      ## Field does not exist, create it.
323
      $field = MARC::Field->new( $fieldName, undef, undef, $subfieldName => $value );
324
      $record->append_fields( $field );
325
    }
326
  } else { ## No subfield
327
    if ( my @fields = $record->field( $fieldName ) ) {
328
      foreach my $field ( @fields ) {
329
        $field->update( $value );
330
      }
331
    } else {
332
      ## Field does not exists, create it
333
      $field = MARC::Field->new( $fieldName, $value );
334
      $record->append_fields( $field );
335
    }
336
  }
337
}
338
339
1;
298
1;
340
__END__
299
__END__
(-)a/t/SimpleMARC.t (+188 lines)
Line 0 Link Here
1
use Modern::Perl;
2
3
use Test::More;#tests => 1;
4
5
use Data::Dumper;
6
7
use_ok("MARC::Field");
8
use_ok("MARC::Record");
9
use_ok("Koha::SimpleMARC");
10
11
12
sub new_record {
13
    my $record = MARC::Record->new;
14
    $record->leader('03174nam a2200445 a 4500');
15
    my @fields = (
16
        MARC::Field->new(
17
            100, '1', ' ',
18
            a => 'Knuth, Donald Ervin',
19
            d => '1938',
20
        ),
21
        MARC::Field->new(
22
            245, '1', '4',
23
            a => 'The art of computer programming',
24
            c => 'Donald E. Knuth.',
25
        ),
26
        MARC::Field->new(
27
            650, ' ', '0',
28
            a => 'Computer programming.',
29
            9 => '462',
30
        ),
31
        MARC::Field->new(
32
            952, ' ', ' ',
33
            p => '3010023917',
34
            y => 'BK',
35
            c => 'GEN',
36
            d => '2001-06-25',
37
        ),
38
    );
39
    $record->append_fields(@fields);
40
    return $record;
41
}
42
43
my $record = new_record;
44
45
# field_exists
46
is( field_exists( $record, '650', 'a'), 'Computer programming.', '650$a exists' );
47
is( field_exists( $record, '650', 'b'), undef, '650$b does not exist' );
48
49
$record->append_fields(
50
    MARC::Field->new(
51
        650, ' ', '0',
52
        a => 'Computer algorithms.',
53
        9 => '463',
54
    )
55
);
56
57
is( field_exists( $record, '650', 'a'), 'Computer programming.', '650$a exists, field_exists returns the first one' );
58
59
# read_field
60
my @fields_650a = read_field( $record, '650', 'a');
61
is( $fields_650a[0], 'Computer programming.', 'first 650$a' );
62
is( $fields_650a[1], 'Computer algorithms.', 'second 650$a' );
63
is( read_field( $record, '650', 'a', 1 ), 'Computer programming.', 'first 650$a bis' );
64
is( read_field( $record, '650', 'a', 2 ), 'Computer algorithms.', 'second 650$a bis' );
65
is( read_field( $record, '650', 'a', 3 ), undef, 'There is no 3 650$a' );
66
67
# copy_field
68
copy_field( $record, '245', 'a', '246', 'a' );
69
is_deeply( read_field( $record, '245', 'a' ), 'The art of computer programming', 'After copy 245$a still exists' );
70
is_deeply( read_field( $record, '246', 'a' ), 'The art of computer programming', '246$a is a new field' );
71
delete_field( $record, '246' );
72
is( field_exists( $record, '246', 'a', '246$a does not exist anymore' ), undef );
73
74
copy_field( $record, '650', 'a', '651', 'a' );
75
my @fields_651a = read_field( $record, '651', 'a' );
76
is_deeply( \@fields_651a, ['Computer programming.', 'Computer algorithms.'], 'Copy multivalued field' );
77
delete_field( $record, '651' );
78
79
copy_field( $record, '650', 'a', '651', 'a', undef, 1 );
80
@fields_651a = read_field( $record, '651', 'a' );
81
is_deeply( read_field( $record, '651', 'a' ), 'Computer programming.', 'Copy first field 650$a' );
82
delete_field( $record, '651' );
83
84
copy_field( $record, '650', 'a', '651', 'a', undef, 2 );
85
@fields_651a = read_field( $record, '651', 'a' );
86
is_deeply( read_field( $record, '651', 'a' ), 'Computer algorithms.', 'Copy second field 650$a' );
87
delete_field( $record, '651' );
88
89
copy_field( $record, '650', 'a', '651', 'a', '/Computer/The art of/' );
90
@fields_651a = read_field( $record, '651', 'a' );
91
is_deeply( \@fields_651a, ['The art of programming.', 'The art of algorithms.'], 'Copy field using regex' );
92
93
copy_field( $record, '650', 'a', '651', 'a', '/Computer/The mistake of/' );
94
@fields_651a = read_field( $record, '651', 'a' );
95
is_deeply( \@fields_651a, ['The mistake of programming.', 'The mistake of algorithms.'], 'Copy fields using regex on existing fields' );
96
delete_field( $record, '651' );
97
98
copy_field( $record, '650', 'a', '651', 'a', '/Computer/The art of/' );
99
copy_field( $record, '650', 'a', '651', 'a', '/Computer/The mistake of/', 1, "dont_erase" );
100
@fields_651a = read_field( $record, '651', 'a' );
101
is_deeply( \@fields_651a, [
102
    'The art of programming.',
103
    'The mistake of programming.',
104
    'The art of algorithms.',
105
    'The mistake of programming.'
106
], 'Copy first field using regex on existing fields without erase existing values' );
107
delete_field( $record, '651' );
108
109
copy_field( $record, '650', 'a', '651', 'a', '/Computer/The art of/' );
110
copy_field( $record, '650', 'a', '651', 'a', '/Computer/The mistake of/', undef , "dont_erase" );
111
@fields_651a = read_field( $record, '651', 'a' );
112
is_deeply( \@fields_651a, [
113
    'The art of programming.',
114
    'The mistake of programming.',
115
    'The mistake of algorithms.',
116
    'The art of algorithms.',
117
    'The mistake of programming.',
118
    'The mistake of algorithms.'
119
], 'Copy fields using regex on existing fields without erase existing values' );
120
delete_field( $record, '651' );
121
122
123
# update_field
124
update_field( $record, '952', 'p', undef, '3010023918' );
125
is_deeply( read_field( $record, '952', 'p' ), '3010023918', 'update existing subfield 952$p' );
126
delete_field( $record, '952' );
127
update_field( $record, '952', 'p', undef, '3010023918' );
128
update_field( $record, '952', 'y', undef, 'BK' );
129
is_deeply( read_field( $record, '952', 'p' ), '3010023918', 'create subfield 952$p' );
130
is_deeply( read_field( $record, '952', 'y' ), 'BK', 'create subfield 952$k on existing 952 field' );
131
$record->append_fields(
132
    MARC::Field->new(
133
        952, ' ', ' ',
134
        p => '3010023917',
135
        y => 'BK',
136
    ),
137
);
138
update_field( $record, '952', 'p', undef, '3010023919' );
139
my @fields_952p = read_field( $record, '952', 'p' );
140
is_deeply( \@fields_952p, ['3010023919', '3010023919'], 'update all subfields 952$p with the same value' );
141
142
update_field( $record, '952', 'p', undef, ('3010023917', '3010023918') );
143
@fields_952p = read_field( $record, '952', 'p' );
144
is_deeply( \@fields_952p, ['3010023917', '3010023918'], 'update all subfields 952$p with the different values' );
145
146
# move_field
147
$record = new_record;
148
my ( @fields_952d, @fields_952c, @fields_954c, @fields_954p);
149
$record->append_fields(
150
    MARC::Field->new(
151
        952, ' ', ' ',
152
        p => '3010023917',
153
        y => 'BK',
154
    ),
155
);
156
copy_field( $record, '952', 'd', '952', 'd' );
157
@fields_952d = read_field( $record, '952', 'd' );
158
is_deeply( \@fields_952d, ['2001-06-25', '2001-06-25'], 'copy 952$d into others 952 field' );
159
160
move_field( $record, '952', 'c', '954', 'c' );
161
@fields_952c = read_field( $record, '952', 'c' );
162
@fields_954c = read_field( $record, '954', 'c' );
163
is_deeply( \@fields_952c, [], 'The 952$c has moved' );
164
is_deeply( \@fields_954c, ['GEN'], 'Now 954$c exists' );
165
166
move_field( $record, '952', 'p', '954', 'p', undef, 1 ); # Move the first field
167
@fields_952p = read_field( $record, '952', 'p' );
168
@fields_954p = read_field( $record, '954', 'p' );
169
is_deeply( \@fields_952p, ['3010023917'], 'One of 952$p has moved' );
170
is_deeply( \@fields_954p, ['3010023917'], 'Now 954$p exists' );
171
172
$record = new_record;
173
$record->append_fields(
174
    MARC::Field->new(
175
        952, ' ', ' ',
176
        p => '3010023917',
177
        y => 'BK',
178
    ),
179
);
180
181
move_field( $record, '952', 'p', '954', 'p' ); # Move all field
182
@fields_952p = read_field( $record, '952', 'p' );
183
@fields_954p = read_field( $record, '954', 'p' );
184
is_deeply( \@fields_952p, [], 'All 952$p have moved' );
185
is_deeply( \@fields_954p, ['3010023917', '3010023917'], 'Now 2 954$p exist' );
186
187
188
done_testing;
(-)a/t/db_dependent/MarcModificationTemplates.t (+125 lines)
Line 0 Link Here
1
use Modern::Perl;
2
3
use Test::More tests => 66;
4
5
use_ok("C4::MarcModificationTemplates");
6
7
# Creation
8
my $template_id = AddModificationTemplate("template_name");
9
like( $template_id, qr|^\d+$|, "new template returns an id" );
10
11
is( AddModificationTemplateAction(
12
    $template_id, 'move_field', 1,
13
    '464', 'u', '',
14
    '464', '3', '',
15
    '', '', '', '', '', '', '',
16
    'move first 464$u to 464$3'
17
), 1, "Add first action");
18
19
is( AddModificationTemplateAction(
20
    $template_id, 'update_field', 0,
21
    '099', 't', 'LIV',
22
    '', '', '',
23
    'if', '200', 'b', 'equals', 'Text', '',
24
    'Update field 099$t with value LIV if 200$b matches "Text"'
25
), 1, "Add second action");
26
27
is( AddModificationTemplateAction(
28
    $template_id, 'copy_field', 0,
29
    '606', 'a', '',
30
    '607', 'a', '',
31
    'unless', '606', 'a', 'not_equals', '^AJAX', '1',
32
    'Copy field 606$a to 607$a unless 606$a matches RegEx m^AJAX'
33
), 1, "Add third action");
34
35
# Getter
36
my @actions = GetModificationTemplateActions( $template_id );
37
is( @actions, 3, "3 actions are insered");
38
39
for my $action ( @actions ) {
40
    isnt( GetModificationTemplateAction( $action->{mmta_id} ), undef, "action with id $action->{mmta_id} exists" );
41
}
42
43
my $first_action = $actions[0];
44
is( $first_action->{ordering}, 1, "test ordering for first action" );
45
is( $first_action->{action}, 'move_field', "test action for first action" );
46
is( $first_action->{from_field}, '464', "test from_field for first action" );
47
is( $first_action->{from_subfield}, 'u', "test from_subfield for first action" );
48
is( $first_action->{to_field}, '464', "test to_field for first action" );
49
is( $first_action->{to_subfield}, '3', "test to_subfield for first action" );
50
51
my $second_action = $actions[1];
52
is( $second_action->{ordering}, 2, "test ordering for second action" );
53
is( $second_action->{action}, 'update_field', "test action for second action" );
54
is( $second_action->{from_field}, '099',"test from_field for second action" );
55
is( $second_action->{from_subfield}, 't', "test from_subfield for second action" );
56
is( $second_action->{field_value}, 'LIV', "test firld_value for second action" );
57
is( $second_action->{to_field}, '', "test to_field for second action" );
58
is( $second_action->{to_subfield}, '', "test to_subfield for second action" );
59
is( $second_action->{conditional}, 'if', "test conditional for second action" );
60
is( $second_action->{conditional_field}, '200', "test conditional_field for second action" );
61
is( $second_action->{conditional_subfield}, 'b', "test conditional_subfield for second action" );
62
is( $second_action->{conditional_comparison}, 'equals', "test conditional_comparison for second action" );
63
64
my $third_action = $actions[2];
65
is( $third_action->{ordering}, 3, "test ordering for third action" );
66
is( $third_action->{action}, 'copy_field', "test  factionor third action" );
67
is( $third_action->{from_field}, '606', "test from_field for third action" );
68
is( $third_action->{from_subfield}, 'a', "test from_subfield for third action" );
69
is( $third_action->{to_field}, '607', "test to_field for third action" );
70
is( $third_action->{to_subfield}, 'a', "test to_subfield for third action" );
71
is( $third_action->{conditional}, 'unless', "test conditional for third action" );
72
is( $third_action->{conditional_field}, '606', "test conditional_field for third action" );
73
is( $third_action->{conditional_subfield}, 'a', "test conditional_subfield for third action" );
74
is( $third_action->{conditional_comparison}, 'not_equals', "test conditional_comparison for third action" );
75
is( $third_action->{conditional_value}, '^AJAX', "test conditional_value for third action" );
76
77
78
# Modifications
79
is( ModModificationTemplateAction(
80
    $actions[1]->{mmta_id}, 'update_field', 0,
81
    '100', 'u', 'LIV',
82
    '', '', '',
83
    'if', '200', 'c', 'equals', 'Text', '',
84
    'Update field 099$t with value LIV if 200$b matches "Text"'
85
), 1, "Modify second action");
86
87
$second_action = GetModificationTemplateAction( $actions[1]->{mmta_id} );
88
is( $second_action->{ordering}, 2, "test ordering for second action modified" );
89
is( $second_action->{action}, 'update_field', "test action for second action modified" );
90
is( $second_action->{from_field}, '100',"test from_field for second action modified" );
91
is( $second_action->{from_subfield}, 'u', "test from_subfield for second action modified" );
92
is( $second_action->{field_value}, 'LIV', "test firld_value for second action modified" );
93
is( $second_action->{to_field}, '', "test to_field for second action modified" );
94
is( $second_action->{to_subfield}, '', "test to_subfield for second action modified" );
95
is( $second_action->{conditional}, 'if', "test conditional for second action modified" );
96
is( $second_action->{conditional_field}, '200', "test conditional_field for second action modified" );
97
is( $second_action->{conditional_subfield}, 'c', "test conditional_subfield for second action modified" );
98
is( $second_action->{conditional_comparison}, 'equals', "test conditional_comparison for second action modified" );
99
100
# Up and down
101
is( MoveModificationTemplateAction( $actions[2]->{mmta_id}, 'top' ), '1', 'Move the third action on top' );
102
is( MoveModificationTemplateAction( $actions[0]->{mmta_id}, 'bottom' ), '1', 'Move the first action on bottom' );
103
104
is( GetModificationTemplateAction( $actions[0]->{mmta_id} )->{ordering}, '3', 'First becomes third' );
105
is( GetModificationTemplateAction( $actions[1]->{mmta_id} )->{ordering}, '2', 'Second stays second' );
106
is( GetModificationTemplateAction( $actions[2]->{mmta_id} )->{ordering}, '1', 'Third becomes first' );
107
108
is( MoveModificationTemplateAction( $actions[0]->{mmta_id}, 'up' ), '1', 'Move up the first action (was third)' );
109
is( MoveModificationTemplateAction( $actions[0]->{mmta_id}, 'up' ), '1', 'Move up the first action (was second)' );
110
is( MoveModificationTemplateAction( $actions[2]->{mmta_id}, 'down' ), '1', 'Move down the third action (was second)' );
111
112
is( GetModificationTemplateAction( $actions[0]->{mmta_id} )->{ordering}, '1', 'First becomes again first' );
113
is( GetModificationTemplateAction( $actions[1]->{mmta_id} )->{ordering}, '2', 'Second stays again second' );
114
is( GetModificationTemplateAction( $actions[2]->{mmta_id} )->{ordering}, '3', 'Third becomes again third' );
115
116
# Cleaning
117
is( DelModificationTemplateAction( $actions[0]->{mmta_id} ), 2, "Delete the first action, 2 others are reordered" );
118
is( GetModificationTemplateAction( $actions[0]->{mmta_id} ), undef, "first action does not exist anymore" );
119
120
is( DelModificationTemplate( $template_id ), 2, "2 actions are deleted" );
121
122
is( GetModificationTemplateAction( $actions[1]->{mmta_id} ), undef, "second action does not exist anymore" );
123
is( GetModificationTemplateAction( $actions[2]->{mmta_id} ), undef, "third action does not exist anymore" );
124
125
is( GetModificationTemplateActions( $template_id ), 0, "There is no action for deleted template" );
(-)a/tools/marc_modification_templates.pl (-2 / +1 lines)
Lines 28-34 use C4::MarcModificationTemplates; Link Here
28
28
29
my $cgi = new CGI;
29
my $cgi = new CGI;
30
30
31
my $op = $cgi->param('op');
31
my $op = $cgi->param('op') || q{};
32
my $template_id = $cgi->param('template_id');
32
my $template_id = $cgi->param('template_id');
33
33
34
my ($template, $loggedinuser, $cookie)
34
my ($template, $loggedinuser, $cookie)
35
- 

Return to bug 8015