line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl -w |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 Name |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
Class::DBI::DataMigration::Mapping - Abstract parent class for objects that |
6
|
|
|
|
|
|
|
map a single column in a single row from the source database to the target |
7
|
|
|
|
|
|
|
database. |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 Synopsis |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
use Class::DBI::DataMigration::Mapping; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# ... Later, when building $mappings hashref for use by a |
14
|
|
|
|
|
|
|
# Class::DBI::DataMigration::Mapper (which see for synopsis -- |
15
|
|
|
|
|
|
|
# in this example, assume an appropriate @source_keys): |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
foreach my $source_key (@source_keys) { |
18
|
|
|
|
|
|
|
$mappings{$source_key} = new Class::DBI::DataMigration::Mapping; |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# ... Now we can assign $mappings to our Mapper ... |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 Description |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
Class::DBI::DataMigration::Mapping objects are used by |
26
|
|
|
|
|
|
|
Class::DBI::DataMigration::Mapper objects to retrieve the values for |
27
|
|
|
|
|
|
|
particular keys into source database objects; these will in turn be stored |
28
|
|
|
|
|
|
|
under particular keys into newly-created target database objects. |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=cut |
31
|
|
|
|
|
|
|
|
32
|
2
|
|
|
2
|
|
941
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
79
|
|
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
package Class::DBI::DataMigration::Mapping; |
35
|
|
|
|
|
|
|
|
36
|
2
|
|
|
2
|
|
9
|
use base 'Class::Accessor'; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
838
|
|
37
|
2
|
|
|
2
|
|
1963
|
use Carp; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
309
|
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=head1 Methods |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=head2 map |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
Expects two parameters: the key into the source object, and the source object |
44
|
|
|
|
|
|
|
itself. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
The default map() implementation simply uses the source key as a method call on |
47
|
|
|
|
|
|
|
the source object and returns the value thus retrieved. |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
Subclasses may do something fancier. |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=cut |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# subs: |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub map { |
56
|
0
|
|
|
0
|
1
|
|
my ($self, $source_key, $source_object) = @_; |
57
|
0
|
|
|
|
|
|
my $retval = eval qq{ return \$source_object->$source_key }; |
58
|
0
|
0
|
|
|
|
|
$retval = $@ if $@; |
59
|
0
|
|
|
|
|
|
return $retval; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=begin testing |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
use_ok('Class::DBI::DataMigration::Mapping'); |
65
|
|
|
|
|
|
|
can_ok('Class::DBI::DataMigration::Mapping', 'map'); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=end testing |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 Author |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
Dan Friedman, C<< >> |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head1 Copyright & License |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
Copyright 2004 Dan Friedman, All Rights Reserved. |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
78
|
|
|
|
|
|
|
under the same terms as Perl itself. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
Please note that these modules are not products of or supported by the |
81
|
|
|
|
|
|
|
employers of the various contributors to the code. |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=cut |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
1; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
|