line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package SPOPS::Import::Object; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# $Id: Object.pm,v 3.7 2004/06/02 00:48:22 lachoy Exp $ |
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
76541
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
43
|
|
6
|
1
|
|
|
1
|
|
6
|
use base qw( SPOPS::Import ); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
714
|
|
7
|
|
|
|
|
|
|
use SPOPS::Exception qw( spops_error ); |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
$SPOPS::Import::Object::VERSION = sprintf("%d.%02d", q$Revision: 3.7 $ =~ /(\d+)\.(\d+)/); |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
my @FIELDS = qw( include_id fields ); # skip_fields |
12
|
|
|
|
|
|
|
SPOPS::Import::Object->mk_accessors( @FIELDS ); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
########################################; |
16
|
|
|
|
|
|
|
# Core API |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub get_fields { return ( $_[0]->SUPER::get_fields(), @FIELDS ) } |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub run { |
21
|
|
|
|
|
|
|
my ( $self ) = @_; |
22
|
|
|
|
|
|
|
my $fields = $self->fields; |
23
|
|
|
|
|
|
|
my $object_class = $self->object_class; |
24
|
|
|
|
|
|
|
unless ( $fields ) { spops_error "Cannot run without fields defined" } |
25
|
|
|
|
|
|
|
unless ( $object_class ) { spops_error "Cannot run without object class defined" } |
26
|
|
|
|
|
|
|
my $all_data = $self->data; |
27
|
|
|
|
|
|
|
unless ( ref( $all_data ) eq 'ARRAY' and scalar @{ $all_data } > 0 ) { |
28
|
|
|
|
|
|
|
spops_error "Cannot run without data defined"; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
my $num_fields = scalar @{ $fields }; |
32
|
|
|
|
|
|
|
my @status = (); |
33
|
|
|
|
|
|
|
foreach my $data ( @{ $all_data } ) { |
34
|
|
|
|
|
|
|
my $obj = $object_class->new; |
35
|
|
|
|
|
|
|
for ( my $i = 0; $i < $num_fields; $i++ ) { |
36
|
|
|
|
|
|
|
$obj->{ $fields->[ $i ] } = $data->[ $i ]; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
eval { |
39
|
|
|
|
|
|
|
$obj->save({ is_add => 1, |
40
|
|
|
|
|
|
|
DEBUG => $self->DEBUG }) |
41
|
|
|
|
|
|
|
}; |
42
|
|
|
|
|
|
|
if ( $@ ) { |
43
|
|
|
|
|
|
|
push @status, [ undef, $data, $@ ]; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
else { |
46
|
|
|
|
|
|
|
push @status, [ 1, $obj, undef ]; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
return \@status; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
######################################## |
54
|
|
|
|
|
|
|
# Property manipulation |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub fields_as_hashref { |
57
|
|
|
|
|
|
|
my ( $self ) = @_; |
58
|
|
|
|
|
|
|
my $field_list = $self->fields; |
59
|
|
|
|
|
|
|
unless ( ref $field_list eq 'ARRAY' and scalar @{ $field_list } ) { |
60
|
|
|
|
|
|
|
spops_error 'Please set the fields in the importer object using: ', |
61
|
|
|
|
|
|
|
'\$importer->fields( \\\@fields" )'; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
my $count = 0; |
64
|
|
|
|
|
|
|
return { map { $_ => $count++ } @{ $field_list } }; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
######################################## |
68
|
|
|
|
|
|
|
# I/O and property assignment |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub data_from_file { |
71
|
|
|
|
|
|
|
my ( $self, $filename ) = @_; |
72
|
|
|
|
|
|
|
$self->assign_raw_data( $self->raw_data_from_file( $filename ) ); |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub data_from_fh { |
77
|
|
|
|
|
|
|
my ( $self, $fh ) = @_; |
78
|
|
|
|
|
|
|
$self->assign_raw_data( $self->raw_data_from_fh( $fh ) ); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
# Note that we support 'spops_class' and 'field_order' below for |
83
|
|
|
|
|
|
|
# backward compatibility |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub assign_raw_data { |
86
|
|
|
|
|
|
|
my ( $self, $raw_data_orig ) = @_; |
87
|
|
|
|
|
|
|
my @raw_data = @{ $raw_data_orig }; |
88
|
|
|
|
|
|
|
my %meta = %{ shift @raw_data }; |
89
|
|
|
|
|
|
|
$self->object_class( $meta{object_class} || $meta{spops_class} ); |
90
|
|
|
|
|
|
|
$self->fields( $meta{fields} || $meta{field_order} ); |
91
|
|
|
|
|
|
|
delete $meta{ $_ } for( qw( object_class spops_class fields field_order ) ); |
92
|
|
|
|
|
|
|
$self->extra_metadata( \%meta ); |
93
|
|
|
|
|
|
|
$self->data( \@raw_data ); |
94
|
|
|
|
|
|
|
return $self; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
1; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
__END__ |