<% 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!!. % '
'. % "". % ''; % } % % <%init> #there's no ACL for this... haven't used in ages #make XSS-safe if this is used for more than just admins to import data.... die 'meta-import not enabled; remove this if you want to use it';