home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / SQLMinus.pm < prev    next >
Encoding:
Perl POD Document  |  2002-12-13  |  36.1 KB  |  1,374 lines
  1. #!perl -w
  2. # vim:ts=4:sw=4:aw:ai:nowrapscan
  3. #
  4. #
  5.  
  6. package DBI::Shell::SQLMinus;
  7.  
  8. use strict;
  9. use Text::Abbrev ();
  10. use Text::ParseWords;
  11. use Text::Wrap;
  12. use IO::File;
  13. use IO::Tee;
  14. use Carp;
  15.  
  16. use vars qw(@ISA $show $set $VERSION);
  17.  
  18. $VERSION = sprintf( "%d.%02d", q$Revision: 11.91 $ =~ /(\d+)\.(\d+)/ );
  19.  
  20. sub init {
  21.     my ($class, $sh, @args) = @_;
  22.     $class = ref $class || $class;
  23.     my $sqlminus = {
  24.         archive    => {
  25.             log    => undef,
  26.         },
  27.         'breaks' => {
  28.             skip        => [ qw{text} ],
  29.             skip_page    => [ qw{text} ],
  30.             dup            => [ qw{text} ],
  31.             nodup        => [ qw{text} ],
  32.         },
  33.         break_current => {
  34.         },
  35.         'clear'    => {
  36.             break    => undef,
  37.             buffer    => undef,
  38.             columns    => undef,
  39.             computes    => undef,
  40.             screen    => undef,
  41.             sql        => undef,
  42.             timing    => undef,
  43.         },
  44.         db    => undef,
  45.         dbh => undef,
  46.         column => {
  47.             column_name    => [ qw{text} ],
  48.             alias        => [ qw{text} ],
  49.             clear        => [ qw{command} ],
  50.             fold_after    => [ qw{text} ],
  51.             fold_before    => [ qw{text} ],
  52.             format        => [ qw{text} ],
  53.             heading        => [ qw{text} ],
  54.             justify        => [ qw{c l r f} ],
  55.             like        => [ qw{text} ],
  56.             'length'    => [ qw{text} ],
  57.             newline        => [ qw{text} ],
  58.             new_value    => [ qw{text} ],
  59.             noprint        => [ qw{on off} ],
  60.             'print'        => [ qw{on off} ],
  61.             null        => [ qw{text} ],
  62.             on            => 1,
  63.             off            => 0,
  64.             truncated    => [ qw{on off} ],
  65.             type        => [ qw{text} ],
  66.             wordwrapped    => [ qw{on off} ],
  67.             wrapped        => [ qw{on off} ],
  68.             column_format    => undef,
  69.             format_function => undef,
  70.             precision    =>    undef,
  71.             scale        => undef,
  72.         },
  73.         # hash ref contains formats for code.
  74.         column_format => {
  75.         },
  76.         # Hash ref contains the formats for the column headers.
  77.         column_header_format => {
  78.         },
  79.         commands => {
  80.             '@'        => undef,
  81.             'accept'=> undef,
  82.             append    => undef,
  83.             attribute => undef,
  84.             break    => undef,
  85.             btitle    => undef,
  86.             change    => undef,
  87.             clear    => undef,
  88.             copy    => undef,
  89.             column    => undef,
  90.             compute    => undef,
  91.             define    => undef,
  92.             edit    => undef,
  93.             'exec'    => undef,
  94.             get        => undef,
  95.             pause    => undef,
  96.             prompt    => undef,
  97.             repheader=> undef,
  98.             repfooter=> undef,
  99.             run        => undef,
  100.             save    => undef,
  101.             set        => undef,
  102.             show    => undef,
  103.             start    => undef,
  104.             ttitle    => undef,
  105.             undefine=> undef,
  106.         },
  107.         set_current    => {
  108.             appinfo        => undef,
  109.             arraysize    => undef,
  110.             autocommit    => undef,
  111.             autoprint    => undef,
  112.             autorecovery=> undef,
  113.             autotrace    => undef,
  114.             blockterminator=> undef,
  115.             buffer        => undef,
  116.             closecursor    => undef,
  117.             cmdsep        => undef,
  118.             compatibility=> undef,
  119.             concat        => undef,
  120.             copycommit    => undef,
  121.             copytypecheck=> undef,
  122.             define        => undef,
  123.             document    => undef,
  124.             echo        => undef,
  125.             editfile    => undef,
  126.             embedded    => undef,
  127.             escape        => undef,
  128.             feedback    => undef,
  129.             flagger        => undef,
  130.             flush        => undef,
  131.             heading     => 1,
  132.             headsep     => ' ',
  133.             instance     => undef,
  134.             linesize    => 72,
  135.             limit        => undef,
  136.             loboffset    => undef,
  137.             logsource    => undef,
  138.             long        => undef,
  139.             longchunksize    => undef,
  140.             maxdata        => undef,
  141.             newpage        => undef,
  142.             null        => undef,
  143.             numwidth    => undef,
  144.             pagesize    => undef,
  145.             pause        => undef,
  146.             recsep         => 1,
  147.             recsepchar     => ' ',
  148.             scan        => qq{obsolete command: use 'set define' instead},
  149.             serveroutput=> undef,
  150.             shiftinout    => undef,
  151.             showmode    => undef,
  152.             space        => qq{obsolete command: use 'set define' instead},
  153.             sqlblanklines=> undef,
  154.             sqlcase        => undef,
  155.             sqlcontinue    => undef,
  156.             sqlnumber    => undef,
  157.             sqlprefix    => undef,
  158.             sqlprompt    => undef,
  159.             sqlterminator=> undef,
  160.             suffix        => undef,
  161.             tab            => undef,
  162.             termout        => undef,
  163.             'time'        => undef,
  164.             'timing'    => undef,
  165.             trimout        => undef,
  166.             trimspool    => undef,
  167.             'truncate'    => undef,
  168.             underline    => '-',
  169.             verify        => undef,
  170.             wrap        => undef,
  171.         },
  172.         # Each set command may call a custom function.  Included are
  173.         # currently defined sets.  For simple set/get, the value is
  174.         # stored set_current.
  175.         set_commands => {
  176.  
  177.             appinfo        => ['_unimp'],
  178.             arraysize    => ['_unimp'],
  179.             autocommit    => ['_unimp'],
  180.             autoprint    => ['_unimp'],
  181.             autorecovery    => ['_unimp'],
  182.             autotrace    => ['_unimp'],
  183.  
  184.             blockterminator    => ['_unimp'],
  185.             buffer        => ['_unimp'],
  186.  
  187.             closecursor    => ['_unimp'],
  188.             cmdsep        => ['_unimp'],
  189.             compatibility    => ['_unimp'],
  190.             concat        => ['_unimp'],
  191.             copycommit    => ['_unimp'],
  192.             copytypecheck    => ['_unimp'],
  193.  
  194.             define        => ['_unimp'],
  195.             document    => ['_unimp'],
  196.  
  197.             echo        => ['_set_get'],
  198.             editfile    => ['_unimp'],
  199.             embedded    => ['_unimp'],
  200.             escape        => ['_unimp'],
  201.  
  202.             feedback    => ['_unimp'],
  203.             flagger        => ['_unimp'],
  204.             flush        => ['_unimp'],
  205.  
  206.             heading     => ['_set_get'],
  207.             headsep     => ['_set_get'],
  208.  
  209.             instance     => ['_unimp'],
  210.  
  211.             linesize    => ['_set_get'],
  212.             limit        => ['_set_get'],
  213.             loboffset    => ['_unimp'],
  214.             logsource    => ['_unimp'],
  215.             long        => ['_unimp'],
  216.             longchunksize    => ['_unimp'],
  217.  
  218.             maxdata        => ['_unimp'],
  219.  
  220.             newpage        => ['_unimp'],
  221.             null        => ['_set_get'],
  222.             numwidth    => ['_unimp'],
  223.  
  224.             pagesize    => ['_set_get'],
  225.             pause        => ['_unimp'],
  226.  
  227.             recsep         => ['_set_get'],
  228.             recsepchar     => ['_set_get'],
  229.  
  230.             scan        => ['_print_buffer', 
  231.                 qq{obsolete command: use 'set define' instead}],
  232.             serveroutput    => ['_unimp'],
  233.             shiftinout    => ['_unimp'],
  234.             showmode    => ['_unimp'],
  235.             space        => ['_print_buffer', 
  236.                 qq{obsolete command: use 'set define' instead}],
  237.             sqlblanklines    => ['_unimp'],
  238.             sqlcase        => ['_unimp'],
  239.             sqlcontinue    => ['_unimp'],
  240.             sqlnumber    => ['_unimp'],
  241.             sqlprefix    => ['_unimp'],
  242.             sqlprompt    => ['_unimp'],
  243.             sqlterminator    => ['_unimp'],
  244.             suffix        => ['_unimp'],
  245.  
  246.             tab            => ['_unimp'],
  247.             termout        => ['_unimp'],
  248.             'time'        => ['_unimp'],
  249.             'timing'    => ['_unimp'],
  250.             trimout        => ['_unimp'],
  251.             trimspool    => ['_unimp'],
  252.             'truncate'    => ['_unimp'],
  253.  
  254.             underline    => ['_set_get'],
  255.  
  256.             verify        => ['_unimp'],
  257.  
  258.             wrap        => ['_unimp'],
  259.         },
  260.         show => {
  261.             all           => ['_all'],
  262.  
  263.             btitle        => ['_unimp'],
  264.  
  265.             catalogs      => ['_unimp'],
  266.             columns       => ['_unimp'],
  267.  
  268.             errors        => ['_unimp'],
  269.  
  270.             grants        => ['_unimp'],
  271.  
  272.             help          => ['_help'],
  273.             hints         => ['_hints'],
  274.  
  275.             lno           => ['_hints'],
  276.  
  277.             me            => ['_me'],
  278.  
  279.             objects       => ['_unimp'],
  280.  
  281.             packages      => ['_unimp'],
  282.             parameters    => ['_unimp'],
  283.             password      => ['_print_buffer', qq{I don\'t think so!}],
  284.             pno           => ['_unimp'],
  285.  
  286.             release       => ['_unimp'],
  287.             repfooter     => ['_unimp'],
  288.             repheader     => ['_unimp'],
  289.             roles         => ['_unimp'],
  290.  
  291.             schemas       => ['_schemas'],
  292.             sga           => ['_unimp'],
  293.             show          => ['_show_all_commands'],
  294.             spool         => ['_spool'],
  295.             sqlcode       => ['_sqlcode'],
  296.  
  297.             ttitle        => ['_unimp'],
  298.             tables        => ['_tables'],
  299.             types          => ['_types'],
  300.  
  301.             users         => ['_unimp'],
  302.  
  303.             views         => ['_views'],
  304.         },
  305.         sql => {
  306.             pno    => undef,
  307.             lno    => undef,
  308.             release    => undef,
  309.             user    => undef,
  310.         },
  311.     };
  312.  
  313.     my $pi = bless $sqlminus, $class;
  314.  
  315. # add the sqlminus object to the plugin list for reference later.
  316.     $sh->{plugin}->{sqlminus} = $pi;
  317.  
  318.     $pi->{dbh} = \$sh->{dbh};
  319.  
  320.     my $com_ref = $sh->{commands};
  321.  
  322.     foreach (sort keys %{$pi->{commands}}) {
  323.         $com_ref->{$_} = {
  324.             hint => "SQLMinus: $_",
  325.         };
  326.     }
  327.     return $pi;
  328. }
  329. #    'btittle' => {
  330. #        off => undef,
  331. #        on    => undef,
  332. #        col    => undef,
  333. #        skip    => undef,
  334. #        tab    => undef,
  335. #        left    => undef,
  336. #        center    => undef,
  337. #        right    => undef,
  338. #        bold    => undef,
  339. #        format    => undef,
  340. #        text    => undef,
  341. #        variable    => undef,
  342. #    },
  343. #
  344. # break.
  345. #
  346. # BRE[AK] [ON report_element [action [action]]] ...
  347. # 
  348. # where:
  349. # 
  350. # report_element
  351. # 
  352. # Requires the following syntax:
  353. # 
  354. # {column|expr|ROW|REPORT}
  355. # 
  356. # action
  357. # 
  358. # Requires the following syntax:
  359. # 
  360. # [SKI[P] n|[SKI[P]] PAGE][NODUP[LICATES]|DUP[LICATES]]
  361. # 
  362. sub do_break {
  363.     my ($self, $command, @args) = @_;
  364.  
  365.     # print "break command:\n";
  366.  
  367.     my $breaks = $self->{plugin}->{sqlminus}->{breaks};
  368.     my $cbreaks = $self->{plugin}->{sqlminus}->{break_current};
  369.  
  370.     unless( $command ) {
  371.         my $maxlen = 0;
  372.         foreach (keys %$cbreaks ) {
  373.             $maxlen = (length $_ > $maxlen? length $_ : $maxlen );
  374.         }
  375.         my $format = sprintf("%%-%ds", $maxlen );
  376.         foreach my $col_name (sort keys %$cbreaks) { 
  377.             $self->log( sprintf( $format, $col_name ));
  378.             foreach my $col (sort keys %$breaks) {
  379.                 next unless $cbreaks->{$col_name}->{$col};
  380.                 $self->print_buffer_nop(sprintf( "\t%-15s %s\n", $col, 
  381.                     ($cbreaks->{$col_name}->{$col}||'undef') ));
  382.             }
  383.         }
  384.         return;
  385.     }
  386.  
  387.     my @words = quotewords('\s+', 0, join( " ", @args));
  388.  
  389.     WORD:
  390.     while(@words) {
  391.         my $val = shift @words;
  392.  
  393.         if        ($val =~ m/row/i    ) {
  394.         } elsif    ($val =~ m/report/i    ) {
  395.         } elsif    ($val =~ m/on/i        ) { # Skip on
  396.             next WORD;
  397.         } else {
  398.             # Handle a column.
  399.             if (exists $cbreaks->{$val}) {
  400.                 delete $cbreaks->{$val};
  401.             }
  402.             $cbreaks->{$val} = {
  403.                   skip => undef
  404.                 , nodup => undef
  405.             }; # Create the column in the break group.
  406.  
  407.             ACTION:
  408.             while(@words) {
  409.                 my $action = shift @words;
  410.                 $self->print_buffer_nop( "actin $action" );
  411.                 last unless $action =~ m/\bskip|\bpage|\bnodup|\bdup/i;
  412.                 
  413. # These are the accepted action given to a break.
  414.                 if        ($action =~ m/\bskip/i    ) {
  415. # Skip consumes the next value, either page or a number.
  416.                     my $skip_val = shift @words if (@words);
  417.                     unless ($skip_val) {
  418.                         $self->print_buffer( 
  419.                             qq{break: action $action number lines|page} );
  420.                         last;
  421.                     }
  422.  
  423.                     $self->print_buffer_nop( "action $action $skip_val" );
  424.                     if ($skip_val =~ m/(\d+)/) {
  425.                         $cbreaks->{$val}->{skip} =  $skip_val;
  426.                         delete $cbreaks->{$val}->{skip_page} 
  427.                             if (exists $cbreaks->{$val}->{skip_page});
  428.                     } else {
  429.                         $cbreaks->{$val}->{skip_page} = 1;
  430.                         delete $cbreaks->{$val}->{skip} 
  431.                             if (exists $cbreaks->{$val}->{skip});
  432.                     }
  433. # Default value, if nodup/dup is not defined, add.
  434.                     unshift @words, 'nodup';
  435.                     unshift @words, 'nodup' unless (exists
  436.                         $cbreaks->{$val}->{dup} or exists
  437.                         $cbreaks->{$val}->{nodup});
  438.  
  439.                 } elsif ($action =~ m/\bnodup/i    ) {
  440.                     $cbreaks->{$val}->{nodup} =  1;
  441.                     delete $cbreaks->{$val}->{dup} 
  442.                             if (exists $cbreaks->{$val}->{dup});
  443.                 } elsif ($action =~ m/\bdup/i    ) {
  444.                     $cbreaks->{$val}->{dup} =  1;
  445.                     delete $cbreaks->{$val}->{nodup} 
  446.                             if (exists $cbreaks->{$val}->{nodup});
  447.                 } elsif ($action =~ m/\bpage/i    ) {
  448. # Put skip in front of the value and let the skip command handle it.
  449.                     unshift @words, 'skip', $action;
  450.                 } else {
  451.                     $self->print_buffer( 
  452.                         qq{break: action $action unknown, ambiguous, or not supported.} );
  453.                     last;
  454.                 }
  455.             }
  456.         }
  457.         return;
  458.     }
  459.  
  460.     return 
  461.     $self->print_buffer( 
  462.         qq{break: $command unknown, ambiguous, or not supported.} );
  463. }
  464.  
  465. #
  466. # set
  467. #
  468. sub do_set {
  469.     my ($self, $command, @args) = @_;
  470.  
  471.  
  472.     # print "set command:\n";
  473.  
  474.     my $set = $self->{plugin}->{sqlminus}->{set_current};
  475.  
  476.     unless( $command ) {
  477.         my $maxlen = 0;
  478.         foreach (keys %$set ) {
  479.             $maxlen = (length $_ > $maxlen? length $_ : $maxlen );
  480.         }
  481.         my $format = sprintf("%%-%ds %%s", $maxlen );
  482.         foreach (sort keys %$set) { 
  483.             $self->log( 
  484.                 sprintf( $format, $_, $set->{$_} || 'undef' )
  485.             );
  486.         }
  487.         return;
  488.     }
  489.  
  490.     my $options = Text::Abbrev::abbrev(keys %$set);
  491.  
  492.     my $ref = $self->{plugin}->{sqlminus};
  493.  
  494.     if (my $c = $options->{$command}) {
  495.         $self->log( "command: $command " . ref $c . "" );
  496.         if (my $c = $options->{$command}) {
  497.             my ($cmd, @cargs) = @{$ref->{set_commands}->{$c}};
  498.             push(@args, @cargs) if @cargs;
  499.             return $self->{plugin}->{sqlminus}->$cmd(\$self,$c,@args);
  500.         }
  501.     }
  502.     my %l;
  503.     foreach (keys %$options) { $l{$options->{$_}}++ if m/^$command/ }
  504.     my $sug = wrap( "\t(", "\t\t", sort keys %l );
  505.     $sug = "\n$sug)"    if defined $sug;
  506.     $sug = q{}            unless defined $sug;
  507. return 
  508.     $self->print_buffer( 
  509.         qq{set: $command unknown, ambiguous, or not supported.$sug} );
  510. }
  511.  
  512. # show
  513. sub do_show {
  514.     my ($self, $command, @args) = @_;
  515.  
  516.     return unless $command;
  517.  
  518.     my $show = $self->{plugin}->{sqlminus}->{show};
  519.     my $ref = $self->{plugin}->{sqlminus};
  520.  
  521.     my $options = Text::Abbrev::abbrev(keys %$show);
  522.     if (my $c = $options->{$command}) {
  523.         my ($cmd, @cargs) = @{$ref->{show}->{$c}};
  524.         push(@args, @cargs) if @cargs;
  525.         return $self->{plugin}->{sqlminus}->$cmd(\$self,@args);
  526.     }
  527.     my %l;
  528.     foreach (keys %$options) { $l{$options->{$_}}++ if m/^$command/ }
  529.     my $sug = wrap( "\t(", "\t\t", sort keys %l );
  530.     $sug = "\n$sug)"    if        defined $sug;
  531.     $sug = q{}            unless    defined $sug;  # rid warnings
  532. return 
  533.     $self->print_buffer( 
  534.         qq{show: $command unknown, ambiguous, or not supported.$sug} );
  535. }
  536.  
  537. #
  538. # Attempt to allow the user to define format string for query results.
  539. #
  540.  
  541.  
  542. sub do_column {
  543.     my ($self, $command, @args) = @_;
  544.  
  545.     # print "column command:\n" if $self->{debug};
  546.  
  547.     # my $set = $column_format;
  548.     my $ref                        = $self->{plugin}->{sqlminus};
  549.     my $column                    = $ref->{column};
  550.     my $column_format            = $ref->{column_format};
  551.     my $column_header_format    = $ref->{column_header_format};
  552.  
  553.     # If just the format command is issued, print all the current formatted
  554.     # columns.  Currently, only the column name is printed.
  555.     unless( $command ) {
  556.         my $maxlen = 0;
  557.         foreach (keys %$column_format ) {
  558.             $maxlen = (length $_ > $maxlen? length $_ : $maxlen );
  559.         }
  560.         my $format = sprintf("%%-%ds", $maxlen );
  561.         foreach my $col_name (sort keys %$column_format) { 
  562.             $self->log( sprintf( $format, $col_name ));
  563.             foreach my $col (sort keys %$column) {
  564.                 next unless $column_format->{$col_name}->{$col};
  565.                 $self->print_buffer_nop(sprintf( "\t%-15s %s\n", $col, 
  566.                     ($column_format->{$col_name}->{$col}||'undef') ));
  567.             }
  568.         }
  569.         return;
  570.     }
  571.  
  572.     if ( $command =~ m/clear/i ) {
  573.         # clear the format for either one or all columns.
  574.         if (@args) {
  575.             # Next argument column to clear.
  576.             my $f = shift @args;
  577.             # Format defined?
  578.             $self->_clear_format( \$column_format, $f );
  579.         } else {
  580.             # remove all column formats.
  581.  
  582.             foreach my $column (keys %$column_format) {
  583.                 # warn "Removing format for : $column :\n";
  584.                 $self->_clear_format( \$column_format, $column );
  585.             }
  586.  
  587.             # map { delete $column_format->{$_} } keys %$column_format 
  588.                 # if exists $ref->{column_format};
  589.             # map { delete $column_header_format->{$_} } 
  590.                 # keys %$column_header_format 
  591.                 # if exists $ref->{column_header_format};
  592.         }
  593.  
  594.     return $self->log( "format cleared" );
  595.     }
  596.  
  597.     #
  598.     # If column called with only a column name, display the current format.
  599.     #
  600.  
  601.     unless( @args ) {
  602.         return $self->log( "$command: no column format defined." ) 
  603.             unless exists $column_format->{$command};
  604.  
  605.         $self->log( "column $command format: " );
  606.         foreach my $col (sort keys %{$column_format->{$command}}) {
  607.             next unless $column_format->{$command}->{$col};
  608.             $self->print_buffer_nop(sprintf( "\t%-15s %s"
  609.                 , $col
  610.                 , ($column_format->{$command}->{$col}||'undef') ));
  611.         }
  612.         return;
  613.     }
  614.  
  615.     # print "column: $command ", join( " ", @args) , "\n" if $self->{debug};
  616.  
  617.     #
  618.     # column: column name.
  619.     #
  620.  
  621.     # Builds a structure of attributes supported in column formats.
  622.     my ($col, $col_head);
  623.     unless ( exists $column_format->{$command} ) {
  624.         my $struct = {};
  625.         foreach (keys %$column) {
  626.             $struct->{$_} = undef;
  627.         }
  628.         $column_format->{$command} = $struct;
  629.  
  630.         $col = $column_format->{$command};
  631.  
  632.         $col->{on} = 1;
  633.         $col->{off} = 0;
  634.     }
  635.  
  636.     $col = $column_format->{$command} unless $col;
  637.     $col_head = $column_header_format->{$command} unless $col_head;
  638.  
  639.  
  640.     my $options = Text::Abbrev::abbrev(keys %$column);
  641.  
  642.     # Handle quoted words or phrases.
  643.     my @words = quotewords('\s+', 0, join( " ", @args));
  644.  
  645.     print "column: $command ", join( " ", @words) , "\n" 
  646.         if $self->{debug};
  647.  
  648.     while(@words) {
  649.         my ( $text, $on, $off, $justify );
  650.         my $argv = shift @words;
  651.         my $c = exists $options->{$argv} ? $options->{$argv} : undef;
  652.         # determine if the current argument is part of the format
  653.         # string or a value.
  654.         if ($c) {
  655.             if    ( $c =~ m/alias/i ) {
  656.                 ########################################################
  657.                 # Alias
  658.                 ########################################################
  659.                 $col->{$c} = shift @words;
  660.                 $self->log( "setting alias ... $col->{$c} ..." ) 
  661.                     if $self->{debug};
  662.             } elsif ( $c =~ m/clear/i ) {
  663.                 ########################################################
  664.                 # Clear: syntax column column_name clear
  665.                 ########################################################
  666.                 $self->_clear_format( \$column_format, $command );
  667.                 return $self->log( "format cleared" );
  668.             } elsif ( $c =~ m/fold_after/i ) {
  669.                 ########################################################
  670.                 # Fold After
  671.                 ########################################################
  672.             } elsif ( $c =~ m/fold_before/i ) {
  673.                 ########################################################
  674.                 # Fold Before
  675.                 ########################################################
  676.             } elsif ( $c =~ m/format/i ) {
  677.                 ########################################################
  678.                 # Format
  679.                 ########################################################
  680.                 # Begin with format of A# strings, 9 numeric.
  681.                 my $f = shift @words;
  682.                 return $self->column_usage( {format => 'undef'} )
  683.                     unless $f;
  684.  
  685.                     $self->_determine_format( $f, \$col );
  686.  
  687.             } elsif ( $c =~ m/heading/i ) {
  688.                 ########################################################
  689.                 # Heading
  690.                 ########################################################
  691.                 $col->{$c} = shift @words;
  692.                 $self->log( "setting heading ... $col->{$c} ..." )
  693.                     if $self->{debug};
  694.             } elsif ( $c =~ m/justify/i ) {
  695.                 ########################################################
  696.                 # Justify
  697.                 ########################################################
  698.                 # unset current justification.
  699.                 my $f = shift @words;
  700.                 # Handle special conditions.
  701.                 if ($f =~ m/(?:of(?:f)?)/) {
  702.                     $col->{$c} = undef;
  703.                     $self->log( "justify cleared ... $f ..." ) if
  704.                         $self->{debug};
  705.                     next;
  706.                 }
  707.  
  708.                 $col->{$c} = undef;
  709.  
  710.                 foreach my $just (@{$column->{$c}}) {
  711.                     #$self->log( "\ttesting $f $just" ) if $self->{debug};
  712.                     if ($f =~ m/^($just)/i) {
  713.                         #$self->log( "\tmatch $f and $just" ) if $self->{debug};
  714.                         $col->{$c} = $1;
  715.                         last;
  716.                     }
  717.                 }
  718.                 return $self->log( "invalid justification $f" ) unless
  719.                     $col->{$c};
  720.                 $self->log( "setting justify ... $col->{$c}  $f ..." )
  721.                     if $self->{debug};
  722.             } elsif ( $c =~ m/like/i ) {
  723.                 ########################################################
  724.                 # Like
  725.                 ########################################################
  726.                 $col->{$c} = shift @words;
  727.             } elsif ( $c =~ m/newline/i ) {
  728.                 ########################################################
  729.                 # Newline
  730.                 ########################################################
  731.             } elsif ( $c =~ m/new_value/i ) {
  732.                 ########################################################
  733.                 # New Value
  734.                 ########################################################
  735.             } elsif ( $c =~ m/noprint/i ) {
  736.                 ########################################################
  737.                 # No Print
  738.                 ########################################################
  739.                 $col->{$c}        = 1;
  740.                 $col->{'print'}    = 0;
  741.                 $self->log( "setting noprint ... $col->{$c} ..." )
  742.                     if $self->{debug};
  743.             } elsif ( $c =~ m/print/i ) {
  744.                 ########################################################
  745.                 # Print
  746.                 ########################################################
  747.                 $col->{$c}            = 1;
  748.                 $col->{'noprint'}    = 0;
  749.                 $self->log( "setting print ... $col->{$c} ..." )
  750.                     if $self->{debug};
  751.             } elsif ( $c =~ m/null/i ) {
  752.                 ########################################################
  753.                 # Null
  754.                 ########################################################
  755.                 $col->{$c} = shift @words;
  756.                 $self->log( "setting null text ... $col->{$c} ..." )
  757.                     if $self->{debug};
  758.             } elsif ( $c =~ m/on/i ) {
  759.                 ########################################################
  760.                 # On
  761.                 ########################################################
  762.                 $col->{$c}            = 1;
  763.                 $col->{off}            = 0;
  764.                 $self->log( "setting format on ... $col->{$c} ..." )
  765.                     if $self->{debug};
  766.             } elsif ( $c =~ m/off/i ) {
  767.                 ########################################################
  768.                 # Off
  769.                 ########################################################
  770.                 $col->{$c}            = 1;
  771.                 $col->{on}            = 0;
  772.                 $self->log( "setting format off ... $col->{$c} ..." )
  773.                     if $self->{debug};
  774.             } elsif ( $c =~ m/truncated/i ) {
  775.                 ########################################################
  776.                 # Truncated
  777.                 ########################################################
  778.                 $col->{$c} = 1;
  779.                 $col->{'wrapped'} = 0;
  780.                 $self->log( "setting truncated ... $col->{$c} ..." )
  781.                     if $self->{debug};
  782.             } elsif ( $c =~ m/wordwrapped/i ) {
  783.                 ########################################################
  784.                 # Word Wrapped
  785.                 ########################################################
  786.                 $self->log( "setting wordwrapped ... $col->{$c} ..." )
  787.                     if $self->{debug};
  788.             } elsif ( $c =~ m/wrapped/i ) {
  789.                 ########################################################
  790.                 # Wrapped
  791.                 ########################################################
  792.                 $col->{$c} = 1;
  793.                 $col->{'truncated'} = 0;
  794.                 $self->log( "setting wrapped ... $col->{$c} ..." )
  795.                     if $self->{debug};
  796.             } else {
  797.                 ########################################################
  798.                 # Unknown
  799.                 ########################################################
  800.                 $self->log( "column unknown option: ... $c ..." )
  801.                     if $self->{debug};
  802.             }
  803.  
  804.         }
  805.     }
  806.     #
  807.     # At this point the format is defined for the current column, now build
  808.     # the format string.
  809.     #
  810.     {
  811.         # Default justify is left.
  812.         my $justify = '<';
  813.  
  814.         $self->log ("Truncated and Warpped both set for this column: $col->{name}" )
  815.             if (exists $col->{truncated}    and
  816.                 exists $col->{wrapped}        and
  817.                 $col->{truncated}            and 
  818.                 $col->{wrapped}
  819.             );
  820.  
  821.         $justify = '<' if defined $col->{truncated};
  822.         $justify = '[' if defined $col->{wrapped};
  823.  
  824.         if (defined $col->{'justify'}) {
  825.             if ($col->{'justify'} eq 'l') {
  826.                 $justify = 
  827.                     (defined $col->{wrapped} ? '[' : '<');
  828.             } elsif ( $col->{'justify'} eq 'r' ) {
  829.                 $justify =
  830.                     (defined $col->{wrapped} ? ']' : '>');
  831.             } elsif ( $col->{'justify'} eq 'c' ) {
  832.                 $justify = 
  833.                     (defined $col->{wrapped} ? '|' : '^');
  834.             } else {
  835.                 $self->log( "unknown justify $col->{'justify'}" )
  836.                     if $self->{debug};
  837.                 $justify = '<';
  838.             }
  839.         }
  840.  
  841.         # warn "build format for column: " . $command . "\n";
  842.  
  843.         unless (defined $col->{'length'}) {
  844.             $col->{'length'} = length $command;
  845.         }
  846.  
  847.         # Allow for head and column format differences.
  848.         $col_head->{'format'} = $justify x $col->{'length'};
  849.         $col->{'format'} = $justify x $col->{'length'};
  850.  
  851.         # foreach my $col (sort keys %{$column_format->{$command}}) {
  852.         #     next unless $column_format->{$command}->{$col};
  853.         #     printf( "\t%-15s %s\n", $col, ($column_format->{$command}->{$col}||'undef') );
  854.         # }
  855.  
  856.     }
  857.  
  858. return;
  859. }
  860.  
  861. sub column_usage {
  862.     my ($self, $error ) = @_;
  863.     return $self->print_buffer( 
  864.         join( " ",
  865.             qq{usage column:  },
  866.             (map { "$_ is $error->{$_}" } keys %$error ),
  867.         )
  868.     );
  869. }
  870.  
  871. sub _clear_format {
  872.     my ($self, $column_formats, $column) = @_;
  873.  
  874.     # warn "Removing format for : $column :\n";
  875.  
  876.     if (exists $$column_formats->{$column}) {
  877.         # Out of here!
  878.         delete $$column_formats->{$column};
  879.         # delete $$column_header_format->{$column};
  880.     } else {
  881.         # Can clear it, not defined.
  882.         $self->alert( "column clear $column: format not defined." );
  883.     }
  884.  
  885. }
  886.  
  887.  
  888. sub _determine_format {
  889.     my ($self, $format_requested, $mycol) = @_;
  890.  
  891.     my $col = ${$mycol};
  892.     my $numeric = ();
  893.  
  894.     # Determine what type of format?
  895.  
  896.     if ( $format_requested =~ m/a(\d+)/i ) {                # Character
  897.         $col->{'length'}    = $1;
  898.         $col->{'type'}        = 'char';
  899.         $col->{'format_function'} = undef;
  900.     } elsif ( $format_requested =~ m/^date$/ ) { # Date
  901.         $col->{'length'}    = 8;
  902.         $col->{'type'}        = 'date';
  903.         $col->{'format_function'} = undef;
  904.     } elsif ( $format_requested =~ m/(\d+)/ ) { # Numeric 9's
  905.         #       999.99 
  906.         # ^^^^^^^^^ ^^^^^
  907.         # PRECISION SCALE
  908.  
  909.         $col->{'format_function'} = undef;
  910.  
  911.         $col->{'type'}        = 'numeric';
  912.  
  913.         my $len = $format_requested        =~ tr /[0-9]/[0-9]/;
  914.         $len++ while($format_requested    =~ m/[BSVG\.\$]|MI/ig);
  915.         $len += $format_requested        =~ tr/,/,/;
  916.  
  917.         # Length is defined as total length of the formatted results.
  918.         $col->{'length'}    = $len;
  919.  
  920.         # Determine precision and scale:
  921.         my ($p,$s) = (0,0);
  922.         my ($p1,$s1) = split(/\./, $format_requested);
  923.         $p = $p1  =~ tr /[0-9]/[0-9]/ if $p1;
  924.         $s = $s1  =~ tr /[0-9]/[0-9]/ if $s1;
  925.  
  926.         # warn "$format_requested/precision($p)/scale($s)/length($len)\n";
  927.  
  928.         $col->{'precision'}    = $p;
  929.         $col->{'scale'}        = $s;
  930.  
  931.         # default the commify to NO.
  932.         $col->{'commify'} = 0;
  933.  
  934.         # $         $9999
  935.         if ($format_requested =~ m/\$/) {
  936.             # warn "adding function dollarsign\n";
  937.             $col->{'format_function'} = \&dollarsign;
  938.         }
  939.  
  940.         # B         B9999
  941.         $numeric->{B}++            if $format_requested =~ m/B/i;
  942.         # MI         9999MI
  943.         $numeric->{MI}++        if $format_requested =~ m/MI/i;
  944.         # S         S9999
  945.         $numeric->{S}++            if $format_requested =~ m/S/i;
  946.         # PR         9999PR
  947.         $numeric->{PR}++        if $format_requested =~ m/PR/i;
  948.         # D         99D99
  949.         $numeric->{D}++            if $format_requested =~ m/D/i;
  950.         # G            9G999
  951.         $numeric->{G}++            if $format_requested =~ m/G/i;
  952.         # C         C999
  953.         $numeric->{C}++            if $format_requested =~ m/C/i;
  954.         # L            L999
  955.         $numeric->{L}++            if $format_requested =~ m/L/i;
  956.         # . (period) 99.99
  957.         $numeric->{period}++    if $format_requested =~ m/\./;
  958.         # V         999V99
  959.         $numeric->{V}++            if $format_requested =~ m/V/i;
  960.         # EEEE         9.999EEEE
  961.         $numeric->{EEEE}++        if $format_requested =~ m/EEEE/i;
  962.  
  963.         # , (comma) 9,999
  964.         if ($format_requested =~ m/\,/) {
  965.                 $col->{'commify'} = 1;
  966.         }
  967.     } else {
  968.         return $self->column_usage( {format => "$format_requested invalid" });
  969.     }
  970.     # Save orignal format value.
  971.     $col->{'column_format'} = $format_requested;
  972.  
  973.     $self->log( "setting format ... $col->{'length'} $col->{'type'} ..." ) 
  974.         if $self->{debug};
  975.  
  976. return;
  977. }
  978.  
  979. # Document from Oracle 9i SQL*Plus reference.
  980. #
  981. # FOR[MAT] format
  982. # 
  983. # Specifies the display format of the column. The format specification
  984. # must be a text constant such as A10 or $9,999--not a variable.
  985. # 
  986. # Character Columns The default width of CHAR, NCHAR, VARCHAR2 (VARCHAR)
  987. # and NVARCHAR2 (NCHAR VARYING) columns is the width of the column in
  988. # the database. SQL*Plus formats these datatypes left-justified. If a
  989. # value does not fit within the column width, SQL*Plus wraps or
  990. # truncates the character string depending on the setting of SET WRAP.
  991. # 
  992. # A LONG, CLOB or NCLOB column's width defaults to the value of SET
  993. # LONGCHUNKSIZE or SET LONG, whichever one is smaller.
  994. # 
  995. # To change the width of a datatype to n, use FORMAT An. (A stands for
  996. # alphanumeric.) If you specify a width shorter than the column heading,
  997. # SQL*Plus truncates the heading. If you specify a width for a LONG,
  998. # CLOB, or NCLOB column, SQL*Plus uses the LONGCHUNKSIZE or the
  999. # specified width, whichever is smaller, as the column width.
  1000. # 
  1001. # DATE Columns The default width and format of unformatted DATE columns
  1002. # in SQL*Plus is derived from the NLS parameters in effect. Otherwise,
  1003. # the default width is A9. In Oracle9i, the NLS parameters may be set in
  1004. # your database parameter file or may be environment variables or an
  1005. # equivalent platform-specific mechanism. They may also be specified for
  1006. # each session with the ALTER SESSION command. (See the documentation
  1007. # for Oracle9i for a complete description of the NLS parameters).
  1008. # 
  1009. # You can change the format of any DATE column using the SQL function
  1010. # TO_CHAR in your SQL SELECT statement. You may also wish to use an
  1011. # explicit COLUMN FORMAT command to adjust the column width.
  1012. # 
  1013. # When you use SQL functions like TO_CHAR, Oracle automatically allows
  1014. # for a very wide column.
  1015. # 
  1016. # To change the width of a DATE column to n, use the COLUMN command with
  1017. # FORMAT An. If you specify a width shorter than the column heading, the
  1018. # heading is truncated.
  1019. # 
  1020. # NUMBER Columns To change a NUMBER column's width, use FORMAT followed
  1021. # by an element as specified in Table 8-1.
  1022. # 
  1023. # Table 8-1 Number Formats 
  1024. # Element  Examples  Description  
  1025. # 9            9999
  1026. # 
  1027. #   Number of "9"s specifies number of significant digits returned.
  1028. #   Blanks are displayed for leading zeroes. A zero (0) is displayed for
  1029. #   a value of zero.
  1030. #  
  1031. # 0            0999 9990
  1032. # 
  1033. #   Displays a leading zero or a value of zero in this position as 0. 
  1034. #  
  1035. # $         $9999
  1036. # 
  1037. #   Prefixes value with dollar sign. 
  1038. #  
  1039. # B         B9999
  1040. # 
  1041. #   Displays a zero value as blank, regardless of "0"s in the format model. 
  1042. #  
  1043. # MI         9999MI
  1044. # 
  1045. #   Displays "-" after a negative value. For a positive value, a trailing space is displayed. 
  1046. #  
  1047. # S         S9999
  1048. # 
  1049. #   Returns "+" for positive values and "-" for negative values in this position. 
  1050. #  
  1051. # PR         9999PR
  1052. # 
  1053. #   Displays a negative value in <angle brackets>. For a positive value,
  1054. #   a leading and trailing space is displayed.
  1055. #  
  1056. # D         99D99
  1057. # 
  1058. #   Displays the decimal character in this position, separating the
  1059. #   integral and fractional parts of a number.
  1060. #  
  1061. # G            9G999
  1062. # 
  1063. #   Displays the group separator in this position.
  1064. #  
  1065. # C         C999
  1066. # 
  1067. #   Displays the ISO currency symbol in this position. 
  1068. #  
  1069. # L            L999
  1070. # 
  1071. #   Displays the local currency symbol in this position.
  1072. #  
  1073. # , (comma) 9,999
  1074. # 
  1075. #   Displays a comma in this position. 
  1076. #  
  1077. # . (period) 99.99
  1078. # 
  1079. #   Displays a period (decimal point) in this position, separating the
  1080. #   integral and fractional parts of a number.
  1081. #  
  1082. # V         999V99
  1083. # 
  1084. #   Multiplies value by 10n, where n is number of "9"s after "V". 
  1085. #  
  1086. # EEEE         9.999EEEE
  1087. # 
  1088. #   Displays value in scientific notation (format must contain exactly four "E"s). 
  1089. #  
  1090. # RN or rn     RN
  1091. # 
  1092. #   Displays upper- or lowercase Roman numerals. Value can be an integer between 1 and 3999. 
  1093. #  
  1094. # DATE         DATE
  1095. # 
  1096. #   Displays value as a date in MM/DD/YY format; used to format NUMBER
  1097. #   columns that represent Julian dates.
  1098. #  
  1099. #  
  1100. # 
  1101. # The MI and PR format elements can only appear in the last position of
  1102. # a number format model. The S format element can only appear in the
  1103. # first or last position.
  1104. # 
  1105. # If a number format model does not contain the MI, S or PR format
  1106. # elements, negative return values automatically contain a leading
  1107. # negative sign and positive values automatically contain a
  1108. # leading space.
  1109. # 
  1110. # A number format model can contain only a single decimal character (D)
  1111. # or period (.), but it can contain multiple group separators (G) or
  1112. # commas (,). A group separator or comma cannot appear to the right of a
  1113. # decimal character or period in a number format model.
  1114. # 
  1115. # SQL*Plus formats NUMBER data right-justified. A NUMBER column's width
  1116. # equals the width of the heading or the width of the FORMAT plus one
  1117. # space for the sign, whichever is greater. If you do not explicitly use
  1118. # FORMAT, then the column's width will always be at least the value of
  1119. # SET NUMWIDTH.
  1120. # 
  1121. # SQL*Plus may round your NUMBER data to fit your format or field width.
  1122. # 
  1123. # If a value cannot fit within the column width, SQL*Plus indicates
  1124. # overflow by displaying a pound sign (#) in place of each digit the
  1125. # width allows.
  1126. # 
  1127. # If a positive value is extremely large and a numeric overflow occurs
  1128. # when rounding a number, then the infinity sign (~) replaces the value.
  1129. # Likewise, if a negative value is extremely small and a numeric
  1130. # overflow occurs when rounding a number, then the negative infinity
  1131. # sign replaces the value (-~).
  1132.  
  1133. # Commify used from the Perl CookBook
  1134. sub commify($) {
  1135.         my $num = reverse $_[0];
  1136.         $num =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
  1137.         return scalar reverse $num;
  1138. }
  1139.  
  1140. sub dollarsign($$$$) {
  1141.         my ($num, $fmtnum, $dlen, $commify) = @_;
  1142.         my $formatted = sprintf "\$%${fmtnum}.${dlen}lf", $num;
  1143.         return ($commify ? commify($formatted) : $formatted);
  1144. }
  1145.  
  1146. sub zerofill($$$$) {
  1147.         my ($num, $fmtnum, $dlen, $commify) = @_;
  1148.         my $formatted = sprintf "%0${fmtnum}.${dlen}lf", $num;
  1149.         return ($commify ? commify($formatted) : $formatted);
  1150. }
  1151.  
  1152. sub signednum($$$$) {
  1153.         my ($num, $fmtnum, $dlen, $commify) = @_;
  1154.         my $formatted = sprintf "%+${fmtnum}.${dlen}lf", $num;
  1155.         return ($commify ? commify($formatted) : $formatted);
  1156. }
  1157.  
  1158. sub leadsign($$$$) {
  1159.         my ($num, $fmtnum, $dlen, $commify) = @_;
  1160.         my $formatted = sprintf "%+${fmtnum}.${dlen}lf", $num;
  1161.         return ($commify ? commify($formatted) : $formatted);
  1162. }
  1163.  
  1164. sub trailsign($$$$) {
  1165.         my ($num, $fmtnum, $dlen, $commify) = @_;
  1166.         $dlen--;
  1167.         my $formatted = sprintf "%${fmtnum}.${dlen}lf", abs($num);
  1168.         $formatted .= ($num > 0 ? '+' : '-');
  1169.         return ($commify ? commify($formatted) : $formatted);
  1170. }
  1171.  
  1172. sub ltgtsign($$$$) {
  1173.         my ($num, $fmtnum, $dlen, $commify) = @_;
  1174.         $dlen--;
  1175.         my $formatted = sprintf "%s%${fmtnum}.${dlen}lf%s" 
  1176.             ,($num > 0 ? '' : '<')
  1177.             ,abs($num),
  1178.             ,($num > 0 ? '' : '>');
  1179.         return ($commify ? commify($formatted) : $formatted);
  1180. }
  1181.  
  1182. #
  1183. # Private methods.
  1184. #
  1185.  
  1186. sub _me {
  1187.         my $pi   = shift;
  1188.         my $self = shift;
  1189.         return ${$self}->print_buffer("show me what???")
  1190.                 unless @_;
  1191.         return ${$self}->do_show(@_);
  1192. }
  1193.  
  1194. sub _all {
  1195.         my $pi = shift;
  1196.         my $self = shift;
  1197.         return ${$self}->print_buffer("show all of what???")
  1198.                 unless @_;
  1199.         return ${$self}->do_show(@_);
  1200. }
  1201.  
  1202. sub _show_all_commands {
  1203.         my $pi = shift;
  1204.         my $self = shift;
  1205. return
  1206.         ${$self}->print_buffer("Show supports the following commands:\n\t" .
  1207.                 join( "\n\t", keys %{$pi->{show}}));
  1208. }
  1209.  
  1210. sub _unimp {
  1211.         my $pi = shift;
  1212.         my $self = shift;
  1213.         return ${$self}->print_buffer("unimplemented");
  1214. }
  1215.  
  1216. sub _obsolete {
  1217.         my $pi = shift;
  1218.         my $self = shift;
  1219.         return ${$self}->print_buffer("obsolete: use " . join( " ", @_) );
  1220. }
  1221.  
  1222. sub _print_buffer {
  1223.         my $pi = shift;
  1224.         my $self = shift;
  1225.         return ${$self}->print_buffer(@_);
  1226. }
  1227.  
  1228. sub _set_get {
  1229.         my $pi = shift;
  1230.         my $self = shift;
  1231.         my $command = shift;
  1232.  
  1233.         carp "command undefined: " and return unless defined $command;
  1234.  
  1235. # Use the off to undefine/null a value.
  1236.         if (@_) {
  1237.                 my $val = shift;
  1238.                 if ($val =~ m/off/i) {
  1239.                     $pi->{set_current}->{$command} = undef;
  1240.                 } else {
  1241.                     $pi->{set_current}->{$command} = $val
  1242.                 }
  1243.  
  1244.         }
  1245.         ${$self}->print_buffer(
  1246.                         qq{$command: } .  ($pi->{set_current}->{$command}||
  1247.                         'null')
  1248.         );
  1249. return $pi->{set_current}->{$command};
  1250. }
  1251.  
  1252. #------------------------------------------------------------------
  1253. #
  1254. # Display a list of all schemas.
  1255. #
  1256. #------------------------------------------------------------------
  1257. sub _schemas {
  1258.         my ($pi, $sh, @args) = @_;
  1259.     #
  1260.     # Allow types to accept a list of types to display.
  1261.     #
  1262.     my $sth;
  1263.  
  1264.     my $dbh = ${$sh}->{dbh};
  1265.     $sth = $dbh->table_info('', '%', '', '');
  1266.  
  1267.     unless(ref $sth) {
  1268.         ${$sh}->log( "Advance table_info not supported\n");
  1269.         return;
  1270.     }
  1271.     return ${$sh}->sth_go($sth, 0, 0);
  1272. }
  1273.  
  1274. #------------------------------------------------------------------
  1275. #
  1276. # Display the last sql code, error, and error string.
  1277. #
  1278. #------------------------------------------------------------------
  1279. sub _sqlcode {
  1280.         my ($pi, $sh, @args) = @_;
  1281.  
  1282.     my $dbh = ${$sh}->{dbh};
  1283.  
  1284.     my $codes;
  1285.     
  1286.     $codes .= "last dbi error        : " . $dbh->err . "\n"        if $dbh->err;
  1287.     $codes .= "last dbi error string : " . $dbh->errstr . "\n"    if $dbh->err;
  1288.     $codes .= "last dbi error state  : " . $dbh->state    . "\n"    if $dbh->err;
  1289.  
  1290.     ${$sh}->print_buffer_nop( $codes ) if defined $codes;
  1291.  
  1292.     return $dbh->err||0;
  1293. }
  1294.  
  1295. #------------------------------------------------------------------
  1296. #
  1297. # Display a list of all tables.
  1298. #
  1299. #------------------------------------------------------------------
  1300. sub _tables {
  1301.         my ($pi, $sh, @args) = @_;
  1302.     return $pi->_sup_types( $sh, 'TABLE', @args );
  1303. }
  1304.  
  1305. #------------------------------------------------------------------
  1306. #
  1307. # Display a list of all types.
  1308. #
  1309. #------------------------------------------------------------------
  1310. sub _types {
  1311.         my ($pi, $sh, @args) = @_;
  1312.     #
  1313.     # Allow types to accept a list of types to display.
  1314.     #
  1315.     my $sth;
  1316.     if (@args) {
  1317.         return $pi->_sup_types( $sh, @args );
  1318.     } 
  1319.  
  1320.     my $dbh = ${$sh}->{dbh};
  1321.     $sth = $dbh->table_info('', '', '', '%');
  1322.  
  1323.     unless(ref $sth) {
  1324.         ${$sh}->log( "Advance table_info not supported\n" );
  1325.         return;
  1326.     }
  1327.     return ${$sh}->sth_go($sth, 0, 0);
  1328. }
  1329.  
  1330. #------------------------------------------------------------------
  1331. #
  1332. # Display a list of all views.
  1333. #
  1334. #------------------------------------------------------------------
  1335. sub _views {
  1336.         my ($pi, $sh, @args) = @_;
  1337.  
  1338.     return $pi->_sup_types( $sh, 'VIEW', @args );
  1339. }
  1340.  
  1341. #------------------------------------------------------------------
  1342. #
  1343. # Handle different types.
  1344. #
  1345. #------------------------------------------------------------------
  1346. sub _sup_types {
  1347.         my ($pi, $sh, $type, @args) = @_;
  1348.  
  1349.     $sh = ${$sh}; # Need to dereference the shell object.
  1350.  
  1351.     my $dbh = $sh->{dbh};
  1352.  
  1353.     return unless (defined $type);
  1354.  
  1355.     my $sth;
  1356.     if (@args) {
  1357.         my $tbl = join( ",", @args );
  1358.         $sth = $dbh->table_info(undef, undef, $tbl, $type);
  1359.     } else {
  1360.         $sth = $dbh->table_info(undef, undef, undef, $type);
  1361.     }
  1362.  
  1363.     unless (ref $sth) {
  1364.         ${$sh}->log( "Advance table_info not supported\n" );
  1365.         return;
  1366.     }
  1367.  
  1368.     return $sh->sth_go($sth, 0, 0);
  1369. }
  1370.  
  1371. 1;
  1372.  
  1373.  
  1374.