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/persistance/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 $table = $map->{$object}->{cdbi}->table;
  34
  35         print <<"       XML";
  36         <class id="$short_name" oils_obj:fieldmapper="$fm" oils_persist:tablename="$table">
  37                 <fields oils_persist:primary="$primary">
  38         XML
  39
  40         for my $field (sort { $$map{$object}{fields}{$a}{position} <=> $$map{$object}{fields}{$b}{position}} keys %{$map->{$object}->{fields}}) {
  41                 my $position = $map->{$object}->{fields}->{$field}->{position};
  42                 my $virtual = $map->{$object}->{fields}->{$field}->{virtual} ? 'true' : 'false';
  43                 print <<"               XML";
  44                         <field name="$field" oils_obj:array_position="$position" oils_persist:virtual="$virtual" />
  45                 XML
  46         }
  47
  48         print <<"       XML";
  49                 </fields>
  50                 <links>
  51         XML
  52
  53         my $meta = $$map{$object}{cdbi}->meta_info();
  54         #warn Dumper($meta);
  55
  56         for my $reltype ( keys %$meta ) {
  57                 for my $colname ( keys %{ $$meta{$reltype} } ) {
  58                         my $col = $$meta{$reltype}{$colname};
  59
  60                         my $f_class = $col->foreign_class;
  61                         my $fm_link = "Fieldmapper::$f_class";
  62                         next unless $$map{$fm_link}{cdbi};
  63
  64                         my $f_key = $col->args->{foreign_key} || ($f_class->columns('Primary'))[0];
  65                         my $f_hint = $$map{$fm_link}{hint};
  66                         my $map = join ' ', @{ $col->args->{mapping} } if ( $col->args->{mapping} );
  67
  68                         print <<"                       XML";
  69                         <link field="$colname" reltype="$reltype" key="$f_key" map="$map" class="$f_hint"/>
  70                         XML
  71                 }
  72         }
  73
  74         print <<"       XML";
  75                 </links>
  76         </class>
  77         XML
  78 }
  79
  80 print <<XML;
  81 </IDL>
  82 XML
  83
  84