LP1054322 - libparent-perl not needed for Ubuntu Precise
[working/Evergreen.git] / Open-ILS / src / extras / fieldmapper_IDL.pl
1 #!/usr/bin/perl
2 use strict;
3 use Data::Dumper;
4 use lib '../perlmods/';
5
6 { package OpenILS::Application::Storage; sub register_method {}; }
7
8 my $map = {};
9 eval "
10         use lib '../perlmods/';
11         use lib '../../../OpenSRF/src/perlmods/';
12         use OpenILS::Utils::Fieldmapper;  
13         use OpenILS::Application::Storage::Driver::Pg::dbi;  
14 ";
15 $map = $Fieldmapper::fieldmap unless ($@);
16
17 die $@ if ($@);
18
19
20 warn "Generating fieldmapper IDL xml...\n";
21
22 print <<XML;
23 <IDL xmlns="http://opensrf.org/spec/IDL/base/v1" xmlns:oils_persist="http://open-ils.org/spec/opensrf/IDL/persistence/v1" xmlns:oils_obj="http://open-ils.org/spec/opensrf/IDL/objects/v1">
24 XML
25
26
27 for my $object (keys %$map) {
28         next unless ($map->{$object}->{cdbi});
29
30         my $fm = $$map{$object}{cdbi};
31         my $short_name= $map->{$object}->{hint};
32         my ($primary) = $map->{$object}->{cdbi}->columns('Primary');
33         my ($seq) = $map->{$object}->{cdbi}->sequence;
34         my $table = $map->{$object}->{cdbi}->table;
35
36         print <<"       XML";
37         <class id="$short_name" oils_obj:fieldmapper="$fm" oils_persist:tablename="$table">
38                 <fields oils_persist:primary="$primary" oils_persist:sequence="$seq">
39         XML
40
41         for my $field (sort { $$map{$object}{fields}{$a}{position} <=> $$map{$object}{fields}{$b}{position}} keys %{$map->{$object}->{fields}}) {
42                 my $position = $map->{$object}->{fields}->{$field}->{position};
43                 my $virtual = $map->{$object}->{fields}->{$field}->{virtual} ? 'true' : 'false';
44                 print <<"               XML";
45                         <field name="$field" oils_obj:array_position="$position" oils_persist:virtual="$virtual" />
46                 XML
47         }
48
49         print <<"       XML";
50                 </fields>
51                 <links>
52         XML
53
54         my $meta = $$map{$object}{cdbi}->meta_info();
55         #warn Dumper($meta);
56
57         for my $reltype ( keys %$meta ) {
58                 for my $colname ( keys %{ $$meta{$reltype} } ) {
59                         my $col = $$meta{$reltype}{$colname};
60                         
61                         my $f_class = $col->foreign_class;
62                         my $fm_link = "Fieldmapper::$f_class";
63                         next unless $$map{$fm_link}{cdbi};
64
65                         my $f_key = $col->args->{foreign_key} || ($f_class->columns('Primary'))[0];
66                         my $f_hint = $$map{$fm_link}{hint};
67                         my $map = join ' ', @{ $col->args->{mapping} } if ( $col->args->{mapping} );
68
69                         print <<"                       XML";
70                         <link field="$colname" reltype="$reltype" key="$f_key" map="$map" class="$f_hint"/>
71                         XML
72                 }
73         }
74
75         print <<"       XML";
76                 </links>
77         </class>
78         XML
79 }
80
81 print <<XML;
82 </IDL>
83 XML
84
85