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 / Completion.pm < prev    next >
Encoding:
Perl POD Document  |  2002-12-13  |  11.4 KB  |  433 lines
  1. package DBI::Shell::Completion;
  2. # vim:ts=4:sw=4:ai:aw:nowrapscan
  3.  
  4. use strict;
  5. use vars qw(@ISA $VERSION);
  6. use Carp;
  7.  
  8. $VERSION = sprintf( "%d.%02d", q$Revision: 11.91 $ =~ /(\d+)\.(\d+)/ );
  9.  
  10. my ($loa, @matches, @tables, @table_list, $tbl_nm, $term, $history);
  11.  
  12.  
  13. sub init {
  14.     my ($class, $sh, @args) = @_;
  15.     $class = ref $class || $class;
  16.     $loa = {
  17.         'catalogs'    => undef,
  18.         'commands' => undef,
  19.         'sql'    => [ sort qw(
  20.             select insert update delete
  21.             alter grant revoke
  22.             from where order by desc asc
  23.             join exists spool
  24.             set min max avg count
  25.             into values
  26.            ) ],
  27.         'select_func' => [ sort qw(
  28.             count(*) min max avg as distinct unique
  29.         ) ],
  30.         'schemas' => undef, 
  31.         'system' => undef, 
  32.         'tables'  => undef,
  33.         'ntables'  => undef,    # Maintain a list of columns by table.
  34.         'sql_keywords' => undef,
  35.         'users'   => undef,
  36.         'views'   => undef,
  37.         'term'    => undef, # Maintain a reference to the term type.
  38.         'history' => '.dbish_history',
  39.         'command_prefix' => undef,
  40.         'columns'    => undef,
  41.     };
  42.  
  43.     
  44.  
  45.     # Modify the history location to use the users home directory, if
  46.     # available.
  47.     # TODO: Change this to be less unix more perl
  48.     $loa->{history} = $sh->{home_dir} . '/' . $loa->{history}
  49.         if (exists $sh->{home_dir} and defined $sh->{home_dir});
  50.  
  51.     $sh->log( "commandline history written to $loa->{history}" );
  52.  
  53.     my $pi = bless $loa, $class;
  54.  
  55.     # return if term is not defined.  
  56.     return unless $sh->{term};
  57.  
  58.     $term = $sh->{term};
  59.  
  60.     my $attribs = $term->Attribs();
  61.     $attribs->{history_length} = '500';
  62.  
  63.     $pi->{term} = \$sh->{term};
  64.     $pi->{dbh} = \$sh->{dbh};
  65.     $pi->{command_prefix} = \$sh->{command_prefix};
  66.  
  67.      if ($term->ReadLine eq "Term::ReadLine::Gnu") {
  68.         print "Using Term::ReadLine::Gnu\n";
  69.  
  70.         # Only source the current drivers Completion, if exists.
  71.         $sh->{completion} = $pi;
  72.  
  73.         # Define the completion function.
  74.         my $ssc = sub {
  75.             return $pi->sql_shell_completion(@_);
  76.         };
  77.         $attribs->{attempted_completion_function} = $ssc;
  78.  
  79.         # read in the history file.
  80.         if(-e $pi->{history}) {
  81.             $sh->log ("History file $pi->{history} not restored!" )
  82.                 unless($term->ReadHistory($pi->{history}));
  83.         } else { 
  84.             print "Creating ${history} to store your command line history\n";
  85.             open(HISTORY, "> $pi->{history}") 
  86.                 or $sh->log ("Could not create $pi->{history}: $!"); 
  87.             close(HISTORY);
  88.         }
  89.  
  90.     }
  91.  
  92.     return $pi;
  93. }
  94.  
  95. # sub load_completion {
  96. #     my $cpi = shift;
  97. #     my $sh  = shift;
  98. #     my @pi;
  99. #     foreach my $where (qw(DBI/Shell/Completion DBI_Shell_Completion)) {
  100. #     my $mod = $where; $mod =~ s!/!::!g; #/ so vim see the syn correctly
  101. #     my @dir = map { -d "$_/$where" ? ("$_/$where") : () } @INC;
  102. #         foreach my $dir (@dir) {
  103. #             opendir DIR, $dir or warn "Unable to read $dir: $!\n";
  104. #             push @pi, map { s/\.pm$//; "${mod}::$_" } grep { /\.pm$/ }
  105. #                 readdir DIR;
  106. #             closedir DIR;
  107. #         }
  108. #     }
  109. #     my $driver = $sh->{data_source};
  110. #     # print STDERR join( " ", @pi, $driver, "\n");
  111. #     foreach my $pi (sort @pi) {
  112. #         #local $DBI::Shell::SHELL = $sh; # publish the current shell
  113. #         eval qq{ use $pi };
  114. #         $sh->alert("Unable to load $pi: $@") if $@;
  115. #     }
  116. #     # plug-ins should remove options they recognise from (localized) @ARGV
  117. #     # by calling Getopt::Long::GetOptions (which is already in pass_through mode).
  118. #     foreach my $pi (@pi) {
  119. #         #local *ARGV = $sh->{unhandled_options};
  120. #     $pi->init($sh);
  121. #     }
  122. # }
  123.  
  124. sub populate {
  125.     my $sh = shift;
  126.     my $list = shift;
  127.  
  128.     return $loa unless $list;
  129.     return undef unless exists $loa->{$list};
  130.  
  131.     # print ( "$list populate ...", join " ", @_, "\n" );
  132.  
  133.     if (@_) {  # User provided a list of values.
  134.         $loa->{$list} = [ @_ ];
  135.     } 
  136.     return $loa->{$list};
  137. }
  138.  
  139. # Attempt to complete on the contents of TEXT.  START and END bound
  140. # the region of rl_line_buffer that contains the word to complete.
  141. # TEXT is the word to complete.  We can use the entire contents of
  142. # rl_line_buffer in case we want to do some simple parsing.  Return
  143. # the array of matches, or NULL if there aren't any.
  144. sub sql_shell_completion {
  145.     my $sh = shift;
  146.     my ($text, $line, $start, $end) = @_;
  147.  
  148.     my @matches = ();
  149.  
  150.     undef $tbl_nm;
  151.  
  152.     # Notes for future development.  The $line is the complete line,
  153.     # start is where the text begins, end where text ends (looks like word
  154.     # boundies).  I need to attempt to determine where I'm in the line, and
  155.     # what was the last key word given.
  156.  
  157.     # print STDERR "text:$text: line:$line: start:$start: end:$end:\n";
  158.     my $cmd_p = ${$sh->{command_prefix}};
  159.  
  160.     # Load the keywords.
  161.     unless (defined $loa->{sql_keywords}) {
  162.         eval {
  163.             # Not all drivers support the get_info function yet, so we
  164.             # need a fall back plan.
  165.             my $key_words = ${$sh->{dbh}}->get_info( 'SQL_KEYWORDS' );
  166.             die unless (defined $key_words);
  167.             my @key_words = split( /\s+/, $key_words);
  168.             die unless (@key_words); # Keywords not supported by driver, default
  169.             $sh->populate( q{sql_keywords}, @key_words )
  170.                 unless (defined $loa->{sql_keywords});
  171.         };
  172.  
  173.         if($@) {
  174.             $sh->populate( q{sql_keywords}, @{$sh->{sql}} );
  175.         }
  176.     }
  177.  
  178.     unless (defined $loa->{columns}) {
  179.         eval {
  180.             my $sth = ${$sh->{dbh}}->column_info( undef, undef, undef, undef );
  181.             die unless $sth; # column_info not supported by all drivers.
  182.             my (%catalogs, %schemas, %tables, %columns);
  183.             while ( my $row = $sth->fetchrow_arrayref ) {
  184.                 $catalogs{$row->[0]}++ if defined $row->[0];    
  185.                 $schemas{$row->[1]}++  if defined $row->[1];    
  186.                 $tables{$row->[2]}++   if defined $row->[2];    
  187.                 $columns{$row->[3]}++  if defined $row->[3];    
  188.  
  189.                 push ( @{$loa->{ntables}->{$row->[2]}}, $row->[3] );
  190.             }
  191.             push( @{$loa->{catalogs}}, sort keys %catalogs ); 
  192.             push( @{$loa->{schemas}},  sort keys %schemas  ); 
  193.             push( @{$loa->{columns}},  sort keys %columns  ); 
  194.         };
  195.  
  196.         push( @{$loa->{columns}}, @{$sh->{select_func}} ); 
  197.     }
  198.  
  199.     # print "line: $line - $cmd_p\n" if $line;
  200.     # Begin by loading all the key words, if available.
  201.     if ( $start == 0 ) {
  202.         # SQL_KEYWORDS
  203.         @matches = 
  204.             ${$sh->{term}}->completion_matches($text,
  205.                 \&sql_keywords_gen);
  206.     }
  207.     # If the last word is "from" attempt to match a schema or table name.
  208.     elsif( 
  209.         $line=~ m/
  210.             \bfrom(?:\s*)?(?:['"])?$
  211.             |
  212.             \bfrom(?:\s*)(?:['"])?(?:[\w.]+)
  213.             |
  214.             \binsert\s+into(?:\s+)?$
  215.             |
  216.             \binsert\s+into\s+(?:['"])?(?:\w+|[\w+.]|\w+\.\w+)$
  217.             |
  218.             \bupdate(?:\s*)?(?:['"])?(?:\w+)?$
  219.             |
  220.             ^${cmd_p}desc(?:\s*)?(?:['"])?(?:\w+)?
  221.             /xi 
  222.     ) {
  223.         $sh->populate(q{tables},
  224.             ${$sh->{dbh}}->tables) unless($loa->{tables});
  225.         @matches = ${$sh->{term}}->completion_matches($text, \&table_generator);
  226.         # |
  227.         # ^${cmd_p}desc(?:\s+)(?:['"])?\w+?$
  228.     } 
  229.     # If we find a select on the line display a column list.
  230.     elsif( $line=~ m/select\s+?$|select\s+\w+?$/i ) {
  231.         @matches = ${$sh->{term}}->completion_matches($text,
  232.             \&column_generator);
  233.     }
  234.     elsif( $line=~ m/
  235.         ^insert\s+
  236.         into\s+
  237.         ((?:\w+|\w+\.\w+))\s+?\(            # )
  238.         /xi ) {
  239.         $tbl_nm = $1;
  240.         unless( exists $loa->{ntables}->{$tbl_nm} ) {
  241.             eval {
  242.                 my $sth = ${$sh->{dbh}}->column_info( undef, undef, $tbl_nm, undef );
  243.                 die unless $sth; # column_info not supported by all drivers.
  244.                 push( @{$loa->{ntables}->{$tbl_nm}},
  245.                     @{$sth->fetchall_arrayref( [3] )} ); 
  246.                 
  247.             };
  248.  
  249.             if ($@) {
  250.                 # Column Info not supported, do it the hard way.
  251.                 {
  252.                     local (${$sh->{dbh}}->{PrintError},
  253.                         ${$sh->{dbh}}->{RaiseError});
  254.                     ${$sh->{dbh}}->{PrintError} = 0;
  255.                     ${$sh->{dbh}}->{RaiseError} = 0;
  256.                     my $sth = ${$sh->{dbh}}->prepare( qq{select * from $tbl_nm where 1 = 2} );
  257.                     $sth->execute;
  258.  
  259.                     unless($sth->err) {
  260.                         push( @{$loa->{ntables}->{$tbl_nm}}, @{$sth->{NAME}} ); 
  261.                     }
  262.                     $sth->finish;
  263.                 }
  264.             }
  265.  
  266.         }
  267.  
  268.         @matches = ${$sh->{term}}->completion_matches($text,
  269.             \&col_tab_gen );
  270.     }
  271.     else {
  272.         # match commands for now.
  273.         @matches = 
  274.             ${$sh->{term}}->completion_matches($text, \&sql_keywords_gen);
  275.     } 
  276.  
  277.     return @matches;
  278. }
  279.  
  280. # Generator function for command completion.  STATE lets us know
  281. # whether to start from scratch; without any state (i.e. STATE == 0),
  282. # then we start at the top of the list.
  283.  
  284. ## Term::ReadLine::Gnu has list_completion_function similar with this
  285. ## function.  I defined new one to be compared with original C version.
  286. {
  287.     my $list_index;
  288.     my (@name, @columns, @tables);
  289.  
  290.     sub column_generator {
  291.     my ($text, $state) = @_;
  292.  
  293.     # If this is a new word to complete, initialize now.  This
  294.     # includes saving the length of TEXT for efficiency, and
  295.     # initializing the index variable to 0.
  296.     unless ($state) {
  297.         $list_index = 0;
  298.         @columns = @{$loa->{columns}};
  299.     }
  300.  
  301.     # Return the next name which partially matches from the
  302.     # command list.
  303.     while ($list_index <= $#columns) {
  304.         $list_index++;
  305.         return $columns[$list_index - 1]
  306.             if ($columns[$list_index - 1] =~ /^$text/i);
  307.     }
  308.     # If no names matched, then return NULL.
  309.     return undef;
  310.     }
  311.  
  312.     sub col_tab_gen {
  313.     my ($text, $state) = @_;
  314.  
  315.     # Just return undef for now.
  316.  
  317.     # If this is a new word to complete, initialize now.  This
  318.     # includes saving the length of TEXT for efficiency, and
  319.     # initializing the index variable to 0.
  320.     unless ($state) {
  321.         $list_index = 0;
  322.         if (exists $loa->{ntables}->{$tbl_nm}) {
  323.             @columns = @{$loa->{ntables}->{$tbl_nm}};
  324.         }
  325.         else {
  326.             @columns = @{$loa->{columns}};
  327.         }
  328.     }
  329.  
  330.     # Return the next name which partially matches from the
  331.     # command list.
  332.     while ($list_index <= $#columns) {
  333.         $list_index++;
  334.         return $columns[$list_index - 1]
  335.             if ($columns[$list_index - 1] =~ /^$text/i);
  336.     }
  337.     # If no names matched, then return NULL.
  338.     return undef;
  339.     }
  340.  
  341.     sub sql_generator {
  342.     my ($text, $state) = @_;
  343.  
  344.     # If this is a new word to complete, initialize now.  This
  345.     # includes saving the length of TEXT for efficiency, and
  346.     # initializing the index variable to 0.
  347.     unless ($state) {
  348.         $list_index = 0;
  349.         @name = @{$loa->{sql}};
  350.     }
  351.  
  352.     # Return the next name which partially matches from the
  353.     # command list.
  354.     while ($list_index <= $#name) {
  355.         $list_index++;
  356.         return $name[$list_index - 1]
  357.         if ($name[$list_index - 1] =~ /^$text/i);
  358.     }
  359.     # If no names matched, then return NULL.
  360.     return undef;
  361.     }
  362.  
  363.     sub sql_keywords_gen {
  364.     my ($text, $state) = @_;
  365.  
  366.     # If this is a new word to complete, initialize now.  This
  367.     # includes saving the length of TEXT for efficiency, and
  368.     # initializing the index variable to 0.
  369.     unless ($state) {
  370.         $list_index = 0;
  371.         @name = @{$loa->{sql_keywords}};
  372.     }
  373.  
  374.     # Return the next name which partially matches from the
  375.     # command list.
  376.     while ($list_index <= $#name) {
  377.         $list_index++;
  378.         return $name[$list_index - 1]
  379.             if ($name[$list_index - 1] =~ /^$text/i);
  380.     }
  381.     # If no names matched, then return NULL.
  382.     return undef;
  383.     }
  384. }
  385.  
  386. {
  387.     my $list_index;
  388.  
  389.     sub table_generator {
  390.     my ($text, $state) = @_;
  391.  
  392.     # If this is a new table to complete, initialize now.  This
  393.     # includes saving the length of TEXT for efficiency, and
  394.     # initializing the index variable to 0.
  395.     unless ($state) {
  396.         $list_index = 0;
  397.         @tables =    @{$loa->{tables}};
  398.     }
  399.  
  400.     # Return the next name which partially matches from the
  401.     # command list.
  402.     while ($list_index <= $#tables) {
  403.         $list_index++;
  404.         return $tables[$list_index - 1]
  405.         if ($tables[$list_index - 1] =~ /^$text/i);
  406.     }
  407.     # If no names matched, then return NULL.
  408.     return undef;
  409.     }
  410. }
  411.  
  412. DESTROY {
  413.     my $sh = shift;
  414.     # term is store as a package variable.
  415.      if ($term && $term->ReadLine eq "Term::ReadLine::Gnu") {
  416.         if($term && $term->history_total_bytes()) {
  417.             my $history = $sh->{completion}->{history};
  418.             if ($history) {
  419.                 unless($term->WriteHistory($history)) {
  420.                     carp ("Could not write history file $history to history_file}. ");
  421.                 }
  422.             }
  423.         }
  424.     }
  425.  
  426.     $term = undef; $sh->{term} = undef;
  427. }
  428.  
  429. END { }
  430.  
  431. 1;
  432. __END__
  433.