<%= include("/elements/header.html",'Map tables') %>
<% #use DBIx::DBSchema; my $schema = new_native DBIx::DBSchema map { $cgi->param($_) } qw( data_source username password ); foreach my $field (qw( data_source username password )) { %> VALUE="<%= $cgi->param($field) %>"> <% } my %schema; use Tie::DxHash; tie %schema, 'Tie::DxHash'; if ( $cgi->param('schema') ) { my $schema_string = $cgi->param('schema'); %> <% %schema = map { /^\s*(\w+)\s*=>\s*(\w+)\s*$/ or die "guru meditation #420: $_"; ( $1 => $2 ); } split( /\n/, $schema_string ); } #first page unless ( $cgi->param('magic') ) { %> <%= hashmaker('schema', [ $schema->tables ], [ grep !/^h_/, dbdef->tables ], ) %>
<% #second page } elsif ( $cgi->param('magic') eq 'process' ) { %> <% my %unique; foreach my $table ( keys %schema ) { my @from_columns = $schema->table($table)->columns; my @fs_columns = dbdef->table($schema{$table})->columns; %> <%= hashmaker( $table.'__'.$unique{$table}++, \@from_columns => \@fs_columns, $table => $schema{$table}, ) %>

<% } %>
<% #third (results) } elsif ( $cgi->param('magic') eq 'process2' ) { print "
\n";

    my %unique;
    foreach my $table ( keys %schema ) {
      ( my $spaces = $table ) =~ s/./ /g;
      print "'$table' => { 'table' => '$schema{$table}',\n".
            #(length($table) x ' '). "         'map'   => {\n";
            "$spaces        'map'   => {\n";
      my %map = map { /^\s*(\w+)\s*=>\s*(\w+)\s*$/
                         or die "guru meditation #420: $_";
                       ( $1 => $2 );
                     }
                 split( /\n/, $cgi->param($table.'__'.$unique{$table}++) );
      foreach ( keys %map ) {
        print "$spaces                     '$_' => '$map{$_}',\n";
      }
      print "$spaces                   },\n";
      print "$spaces      },\n";

    }
    print "\n
"; } else { warn "unrecognized magic: ". $cgi->param('magic'); } %>
<% #hashmaker widget sub hashmaker { my($name, $from, $to, $labelfrom, $labelto) = @_; my $fromsize = scalar(@$from); my $tosize = scalar(@$to); "'. '
$labelfrom$labelto
". qq!\n
". qq!!. '		'. qq!\n
". qq!!. '
'. qq!!. '
'. qq!!. '
'. "". ''; } %>