[if cgi ui_remember] [calc] $CGI->{mv_data_table} = $Values->{mv_data_table}; return [/calc] [/if] [if !cgi mv_data_table] [bounce page="__UI_BASE__/gentable"] [/if] [value name=mv_data_table set="[cgi mv_data_table]" hide=1] [set page_perm]dbconfig[/set] [set table_perm]1[/set] [set ui_class]Admin[/set] [set help_name]genconfig.main[/set] [set icon_name]icon_config.gif[/set] @_UI_STD_HEAD_@ [tmp page_title]Table Configuration: [cgi mv_data_table][/tmp] [perl tables="[list-databases] __UI_META_TABLE__"] %ignore; my @ignore = qw/ Class db_file db_file_extended db_file_extended db_text dir DSN dsn_id Exists_handle EXTENDED file _Insert_h _Checked_capability name Object Read_only type Update_handle /; @ignore{@ignore} = @ignore; %typemap = ( 1 => 'DBM/Memory, default delimiter (TAB)', 2 => 'DBM/Memory, LINE delimiter', 3 => 'DBM/Memory, %% delimiter', 4 => 'DBM/Memory, CSV delimiter', 5 => 'DBM/Memory, PIPE delimiter', 6 => 'DBM/Memory, TAB delimiter', 7 => 'This should never appear (old Msql)', 8 => 'DBI/SQL', 9 => 'LDAP', ); %str_typemap = ( 1 => 'DEFAULT', 2 => 'LINE', 3 => '%%', 4 => 'CSV', 5 => 'PIPE', 6 => 'TAB', 8 => 'SQL', 9 => 'LDAP', ); @include_dir = (); my %seen; for(keys %Db) { my $fig = $Db{$_}->config('included_from'); $fig =~ s:(.*)/::; my $dir = $1; push @include_dir, $dir unless $seen{$dir}++; } %Hash_ref = ( qw! FILTER_FROM FILTER_FROM FILTER_TO FILTER_TO COLUMN_DEF COLUMN_DEF DEFAULT DEFAULT FIELD_ALIAS FIELD_ALIAS NUMERIC NUMERIC WRITE_CATALOG WRITE_CATALOG ! ); %Ary_ref = ( qw! NAME NAME BINARY BINARY POSTCREATE POSTCREATE INDEX INDEX ! ); %Misc_set = ( GUESS_NUMERIC => '=No numeric guess, 1=Guess numeric fields', EXCEL => '=No Excel correction, 1=Correct for Excel peculiarities', LARGE => '=No, 1=Yes (prevents building select list)', HOT => '=Normal open, 1=Keep table always connected', CONTINUE => q{=No extra line processing, DITTO="Ditto" line continuation, UNIX=Unix-style \ continuation, NOTES=Lotus notes (only for LINE delimiter)}, ); %Misc_set_sql = ( LONGTRUNCOK => "1=Silently truncate too-long values, 0=Don't truncate", ); %Adv_set_sql = ( CHOPBLANKS => "1=Strip trailing white space from fixed-length text, 0=Don't strip (warning: dangerous)", HAS_DESCRIBE => "0=No DESCRIBE TABLE available, 1=has DESCRIBE TABLE", HAS_LIMIT => "0=No LIMIT available, 1=has LIMIT to limit rows", AUTOCOMMIT => "=Honor default AutoCommit setting, 0=No AutoCommit, 1=Set AutoCommit", PRINTERROR => "=Honor default PrintError setting, 0=No PrintError, 1=Set PrintError", RAISEERROR => "=Honor default RaiseError setting, 0=No RaiseError, 1=Set RaiseError", ); @Adv_set_sql_text = qw( ALTER_ADD ALTER_CHANGE ALTER_DELETE ALTER_INDEX ALTER_RENAME ALTER_BACKUP ); LOCAL1: { my @k = keys %str_typemap; for (@keys) { $str_typemap{$str_typemap{$_}} = $_; } } [/perl] [if cgi mv_dbconf] [perl] $Dref = {}; my @keys = grep /^mv_dbconf_/, keys %$CGI; my $table = $CGI->{mv_data_table}; my $string = ''; #$string = join "\n", 'KEYS', @keys, ""; for(@keys) { my $key = $_; $key =~ s/^mv_dbconf_//; #$string .= "KEY: $key -- $_\n"; $Dref->{$key} = $CGI->{$_}; } sub tout { my ($param, $data, $prefix) = @_; $prefix = '' unless $prefix; if($data =~ /\n/) { $data = "<<_EOD\n$data\n_EOD\n"; } return sprintf("${prefix}Database %-11s %-15s %s\n", $table, $param, $data); } $string .= tout($Dref->{file}, $str_typemap{ $Dref->{type} } || $Dref->{type}); if($Dref->{DSN_default}) { $string .= tout('DSN', "__SQL" . 'DSN' . "__"); } else { $string .= tout('DSN', $Dref->{DSN}); } if($Dref->{USER_default}) { $string .= "ifdef SQLPASS\n"; for (qw/USER PASS/) { $string .= tout($_, "__SQL" . $_ . "__"); } $string .= "endif\n"; } else { for (qw/USER PASS/) { $string .= tout($_, $Dref->{$_}) if length $Dref->{$_}; } } for (keys %Misc_set, keys %Misc_set_sql,) { $string .= tout($_, $Dref->{$_}) if length $Dref->{$_}; } for (keys %Adv_set, keys %Adv_set_sql, @Adv_set_sql_text) { $string .= tout($_, $Dref->{$_}, '#') if length $Dref->{$_}; } if ($Dref->{CREATE_SQL} =~ /\S/) { $Dref->{CREATE_SQL} =~ s/\s*;\s*$//; $string .= tout('CREATE_SQL', $Dref->{CREATE_SQL}); } if($Dref->{COLUMN_DEF_type}) { my %def; for( qw/name type length notnull key default/) { $def{$_} = [ split /\0/, $Dref->{"COLUMN_DEF_$_"} ]; } my $count = scalar( @{$def{name}} ); for(my $i = 0; $i < $count; $i++) { my $cdef; last if ! ($cdef = $def{name}[$i]); next if ! $def{type}[$i]; $cdef = qq{"$cdef=}; $cdef .= $def{type}[$i]; $cdef .= qq{($def{length}[$i])} if $def{length}[$i] =~ /\S/; $cdef .= qq{ NOT NULL} if $def{notnull}[$i]; $cdef .= qq{ PRIMARY KEY} if $def{key}[$i]; $cdef .= qq{ DEFAULT $def{default}[$i]} if $def{default}[$i] =~ /\S/; $cdef .= qq{"}; $string .= tout('COLUMN_DEF', $cdef); } } if($Dref->{POSTCREATE}) { my @lines = grep /\S/, split /;/, $Dref->{POSTCREATE}; for(@lines) { s/^\s+//; s/\s+$//; $string .= tout('POSTCREATE', $_); } } return "

    $string

"; [/perl] [/if] [output name="top_of_form"] [form-session-id] [output name=""]

[comment] Prevent Safe object creation problems [/comment] [seti have_dbi][version extended=1 modtest='DBI'][/seti] [seti have_ldap][version extended=1 modtest='Net::LDAP'][/seti] [seti dbi_info][version extended=1 db=1][/seti] [perl] my @out; # Some variables are initialized in the first perl area above my $mdb = $Db{__UI_META_TABLE__}; my $dbi_info = $Scratch->{dbi_info}; $dbi_info =~ m/.*available drivers:.*?

> (.*?)<.BLOCKQUOTE>/i; my @dbi_drivers = split /\n/, $1; my $new; my $ref; my $tname = $CGI->{mv_data_table}; my $db = $Db{$tname}; $ref = $Config->{Database}{$tname}; if(! $ref) { $new = 1; $ref = {}; } my $tinfo = ''; if($mdb and $mdb->record_exists($tname) ) { $tinfo = $mdb->field($tname, 'label'); if($tinfo) { $tinfo = "
> ($tinfo)"; } } my $class = $ref->{Class}; my $file = $ref->{file}; my $dir = $ref->{DIR} || $Config->{ProductDir}; my $dfile = ($class eq 'DBI' ? $ref->{db_file_extended} : $ref->{db_file}); $dfile =~ s:^$dir/::o; my $text_type = $typemap{$ref->{type}}; $text_type .= " DSN=$ref->{DSN}" if $ref->{DSN}; my $dfn = $dfile; my $current_sql; my $use_sql; my $base_sql; my $pfile = $Config->{ProductFiles}[0]; if($Db{$pfile} and $Db{$pfile}->config('type') == 8) { $base_sql = $pfile; } my $multi_index = {}; my $uniq_index = {}; my $indexed = {}; if($ref->{INDEX}) { for(@{$ref->{INDEX}}) { s/^\s+//; s/\s+$//; my $uniq = s/^unique[:\s]+//i; s/:\w+//g; if(/,/) { my @ones = split /\s*,\s*/, $_; for ( @ones ) { $multi_index->{$_} = 1; } } elsif ($uniq) { $uniq_index->{$_} = 1; } else { $indexed->{$_} = 1; } } } if(! $new) { $current_sql = 1 if $ref->{type} == 8; my $fn = "$dir/$file"; $file .= "
> `mod date: " . $Tag->file_info( { name => $fn, date => 1 } ); $file .= "
> file size: " . $Tag->file_info( { name => $fn, size => 1 } ); $file .= "`"; $dfile .= "
> (not significant for DBI types)" if $class eq 'DBI'; $dfile .= "
> `mod date: " . $Tag->file_info( { name => $dfn, date => 1 } ); $dfile .= "
> file size: " . $Tag->file_info( { name => $dfn, size => 1 } ); $dfile .= "`"; my $obj = $ref->{Object}; ## push @out, <<EOF; ##
> ##
> ##
> Current Settings
> ##
> ##
> ##
> ##
> Type | $text_type
> ##
> ##
> ##
> ##
> Class | $class
> ##
> ##
> ##
> ##
> Directory | $dir
> ##
> ##
> ##
> ##
> Text File | $file
> ##
> ##
> ##
> ##
> DB File | $dfile
> ## ##
> ##
> ##
> ## EOF } $use_sql = 1 if $current_sql or ($new and $base_sql); push @out, <<EOF;
> EOF my ($wid, $wid_opt); # Don't allow change of table name.... if($new) { push @out, <<EOF;
> Change Settings
> Table name |
> EOF } else { push @out, <<EOF;
> Table name | $tname
> EOF } # Allow upload of new file only if($new) { push @out, <<EOF;
> File name |
> Upload file |
> EOF } $wid_opts = '1=DBM/Memory'; $wid_opts .= ", 8=SQL" if $Scratch->{have_dbi}; $wid_opts .= ", 9=LDAP" if $Scratch->{have_ldap}; $wid = $Tag->widget( { type => 'select', default => $ref->{type}, passed => $wid_opts, name => 'mv_dbconf_type', } ); push @out, <<EOF;
> Table type | $wid
> EOF $wid = $Tag->widget( { type => 'select', default => $ref->{delimiter}, passed => '=Auto-detect, TAB, PIPE, CSV, LINE, %%', name => 'mv_dbconf_DELIMITER', } ); push @out, <<EOF;
> Delimiter type | $wid
> EOF my $def_DSN = $ref->{DSN} eq $Variable->{SQLDSN} ? 'CHECKED' : ''; my $def_USER = $ref->{USER} eq $Variable->{SQLUSER} ? 'CHECKED' : ''; my $def_PASS = $ref->{PASS} eq $Variable->{SQLPASS} ? 'CHECKED' : ''; push @out, <<EOF if $use_sql;
> DSN | use default
> USER | use default
> PASS | use default
> EOF if($ref->{included_from}) { push @out, <<EOF;
> Configuration file | $ref->{included_from}
> EOF } else { $wid_opts = join ", ", @include_dir; $wid = $Tag->widget( { type => 'select', passed => $wid_opts, name => 'mv_dbconf_included_from', } ); push @out, <<EOF;
> Configuration directory | $wid
> EOF } my $def_type = $ref->{DEFAULT_TYPE} || 'char(128)'; if($current_sql or ($new and $base_sql)) { push @out, <<EOF;
> Default type |
> EOF } my $fdbh; if($current_sql) { $fdbh = $Sql{$tname}; } elsif ($new and $base_sql) { $fdbh = $Sql{$base_sql}; } my $addrow_info; ROWINFO: { last ROWINFO unless $fdbh and $fdbh->can('type_info_all'); my $type_info = $fdbh->type_info_all(); last ROWINFO unless $type_info and $ref->{NAME}; $addrow_info = 1; my @types; for(my $i = 1; $i < @{$type_info}; $i++) { my $one = $type_info->[$i]; my $type = "$one->[0]"; #$type .= "$one->[0] - $one->[12]"; #$type .= " (maxlen $one->[2])" if $one->[2] > 0; push @types, $type; } $wid_opts = join ",", "=default $def_type", @types; my $sth; my @names = @{$ref->{NAME}}; my @ftype; my @itype; unless ($new) { my $q = "select * from $tname"; $q .= ' LIMIT 1' if $ref->{HAS_LIMIT}; my $sth = $fdbh->prepare($q); $sth->execute(); @names = @{$sth->{NAME}}; @ftype = @{$sth->{TYPE}}; for (my $i = 0; $i < scalar @ftype; $i++) { $itype[$i] = $type_info->[ $ftype[$i] ]; } undef $sth; } undef $fdbh; my @rows; push @out, <<EOF;

> Field configuration
> EOF # Need this to see if field is added my $orignames = join ",", @names; push @out, qq{}; push @names, 'NEW FIELD'; for(my $i = 0; $i < @names; $i++) { my $name = $names[$i]; push @out, qq{$name
> }; } pop @names; push @names, ''; push @out, <<EOF;

> EOF for(my $i = 0; $i <= scalar @names; $i++) { my $clen = ''; my $rname = $names[$i]; my $add; if(!$rname) { $add = "(add)
> "; } my $pkey = $ref->{KEY_INDEX} == $i ? ' SELECTED' : ''; my $idx = $indexed->{$names[$i]} ? ' SELECTED' : ''; my $midx = $multi_index->{$names[$i]} ? ' SELECTED' : ''; my $uidx = $uniq_index->{$names[$i]} ? ' SELECTED' : ''; my $notnull; my $fdefault; my $tinfo = {}; if($ref->{COLUMN_DEF}{$rname}) { my $def = $ref->{COLUMN_DEF}{$rname}; $def =~ / ^\s* ([^\s(]+)\s* (?: \( ([^)]+ ) \) )?/x; my $ctype = $1; $clen = $2 || ''; $ctype = lc($ctype) if $itype[$i] =~ /[a-z]/; $tinfo->{TYPE_NAME} = $ctype || $itype[$i]; $def =~ /\bNOT\s+NULL\b/i and $notnull = 'SELECTED'; ($def =~ /\bdefault\s+'(.*?)'/i and $fdefault = $1) or ($def =~ /\bdefault\s+(\S+)($|\s)/i and $fdefault = $1); } my $vis = $i ? 'Hidden' : 'Visible'; $wid = $Tag->widget( { type => 'select', passed => $wid_opts, default => $tinfo->{TYPE_NAME}, name => 'mv_dbconf_COLUMN_DEF_type', } ); my $delbox = ' '; if(! $add) { $delbox = <<EOF; delete field $rname EOF } push @out, <<EOF;

> $rname$add

> type | length | default (if any) | action
> $wid |  |  | $delbox
> null status | key status

> EOF } push @out, <<EOF;

> EOF } if(! $addrow_info) { my @names = $db->columns(); unshift @names, '=--no delete--'; my $dstring = join ",", @names; my $sel = $Tag->display( { name => "mv_dbconf_delete_field", type => 'select', options => $dstring, } ); push @out, <<EOF;
> Add a field |
> Delete a field | $sel
> EOF } %misc = %Misc_set; if($current_sql or ($new and $base_sql)) { for(keys %Misc_set_sql) { $misc{$_} = $Misc_set_sql{$_}; } } $wid = '

> '; for(sort keys %misc) { next unless $misc{$_}; $wid .= "
> $_ | "; $wid .= $Tag->widget( { type => 'select', default => $ref->{$_}, passed => $misc{$_}, name => "mv_dbconf_$_", } ); $wid .="
> "; } $wid .= "

> "; push @out, <<EOF;
> Extra settings | $wid
> EOF my $create_sql = $ref->{CREATE_SQL} || $db->create_sql(); $create_sql =~ s/^\s*create\s+table\s+\(/CREATE TABLE $tname (/i; #Debug("create_sql=$create_sql"); if($current_sql or ($new and $base_sql) ) { my @post; if ($ref->{POSTCREATE}) { @post = @{$ref->{POSTCREATE}}; push @post, ""; } my $post = join ";\n", @post; my $extra = ''; if (! $CGI->{custom_table_create}) { $extra = qq{
> }; $extra .= $Tag->page( { href=> '@@MV_PAGE@@', form => " custom_table_create=1 ui_remember=1 ", } ); $extra .= "Custom create SQL"; } push @out, <<EOF;
> SQL after creation$extra | $post
> EOF } if($CGI->{custom_table_create} and ($current_sql or ($new and $base_sql)) ) { push @out, <<EOF;
> Custom table creation SQL | $create_sql
> EOF } %misc = %Adv_set; if($current_sql or ($new and $base_sql)) { for(keys %Adv_set_sql) { $misc{$_} = $Adv_set_sql{$_}; } for(@Adv_set_sql_text) { $misc{$_} = ''; } } my $advanced; $wid = '

> '; for(sort keys %misc) { $advanced = 1; $wid .= "
> $_ | "; my $type = $misc{$_} ? 'select' : 'text'; $wid .= $Tag->widget( { type => $type, default => $ref->{$_}, passed => $misc{$_} || 1, name => "mv_dbconf_$_", } ); $wid .="
> "; } $wid .= "

> "; push @out, <<EOF if $advanced;
> Advanced settings (must uncomment to set in configuration) | $wid
> EOF return join "", @out; [/perl]

[output name=top_buttons] [output name=bottom_buttons] [output name=bottom_of_form] [output name=""] @_UI_STD_FOOTER_@