package Sth;
sub new         { bless {} }
sub execute     {}

package Dbh;
sub new         { bless {} }
sub prepare     { print "$_[1]\n"; Sth->new }
sub get_info    { { 14 => '\\', 10003 => 'N'}->{$_[1]} }
sub TRIM        { my $s = shift; $s =~ s/^\s+//; $s =~ s/\s+$//; return $s; }
sub SUBSTRING   { return substr( $_[0], $_[1] - 1, $_[2]) }
sub CHAR_LENGTH { length $_[0] }
sub is_quoted   {
  my $s = TRIM($_[0]);
  SUBSTRING($s, 1, 1) eq '"' && SUBSTRING($s, CHAR_LENGTH($s), 1) eq '"'
}
sub qid_body    { my $s = TRIM($_[0]); SUBSTRING($s, 2, CHAR_LENGTH($s)-2 ); }
# -----------------------------------------------------------------------------
sub column_info  # perlified SQL/CLI Columns() rules 8 - 19
# -----------------------------------------------------------------------------
{
  my $dbh = shift;  # $sth in SQL/CLI
  my ( $CATVAL, $SCHVAL, $TBLVAL, $COLVAL ) = @_;
  my ( $CATSTR, $SCHSTR, $TBLSTR, $COLSTR ) = ('') x 4;
  my ( $NL1   , $NL2   , $NL3   , $NL4    );

  # Rule 10:
  if ( $dbh->{METADATA_ID} ) {
    unless ( defined $CATVAL) {
      if ( $dbh->get_info( 10003 ) eq 'Y') {  # SQL_CATALOG_NAME
        die 'CLI-specific condition - invalid use of null pointer.';
      }
    }
    unless ( defined $SCHVAL && defined $TBLVAL && defined $COLVAL ) {
      die 'CLI-specific condition - invalid use of null pointer.';
    }
  }
  # Rule 8, 11:
  {
    no warnings;
    $NL1 = length $CATVAL;
    $NL2 = length $SCHVAL;
    $NL3 = length $TBLVAL;
    $NL4 = length $COLVAL;
  }
  # Rule 16:
  if ( $dbh->{METADATA_ID} ) {
    if ( $NL1 ) {
      if ( is_quoted($CATVAL) ) {
        my $TEMPSTR = qid_body($CATVAL);
        $CATSTR = "TABLE_CAT = '$TEMPSTR' AND";
      }
      else {
        $CATSTR = "UPPER(TABLE_CAT) = UPPER('$CATVAL') AND";
      }
    }
    if ( $NL2 ) {
      if ( is_quoted($SCHVAL) ) {
        my $TEMPSTR = qid_body($SCHVAL);
        $SCHSTR = "TABLE_SCHEM = '$TEMPSTR' AND";
      }
      else {
        $SCHSTR = "UPPER(TABLE_SCHEM) = UPPER('$SCHVAL') AND";
      }
    }
    if ( $NL3 ) {
      if ( is_quoted($TBLVAL) ) {
        my $TEMPSTR = qid_body($TBLVAL);
        $TBLSTR = "TABLE_NAME = '$TEMPSTR' AND";
      }
      else {
        $TBLSTR = "UPPER(TABLE_NAME) = UPPER('$TBLVAL') AND";
      }
    }
    if ( $NL4 ) {
      if ( is_quoted($COLVAL) ) {
        my $TEMPSTR = qid_body($COLVAL);
        $COLSTR = "COLUMN_NAME = '$TEMPSTR' AND";
      }
      else {
        $COLSTR = "UPPER(COLUMN_NAME) = UPPER('$COLVAL') AND";
      }
    }
  }
  else {
    my $SPC = 14;  # SQL_SEARCH_PATTERN_ESCAPE
    my $ESC = $dbh->get_info( $SPC );

    if ( $NL1 ) { $CATSTR = "TABLE_CAT = '$CATVAL' AND" }
    if ( $NL2 ) { $SCHSTR = "TABLE_SCHEM LIKE '$SCHVAL' ESCAPE '$ESC' AND" }
    if ( $NL3 ) { $TBLSTR = "TABLE_NAME LIKE '$TBLVAL' ESCAPE '$ESC' AND" }
    if ( $NL4 ) { $COLSTR = "COLUMN_NAME = '$COLVAL' AND" }
  }

  # Rule 17:
  my $PRED = $CATSTR .' '. $SCHSTR .' '. $TBLSTR .' '. $COLSTR .' '.'1=1';
  # Rule 18:
  my $STMT = <<"SQL";
SELECT *
FROM COLUMNS_QUERY
WHERE $PRED
ORDER BY TABLE_CAT, TABLE_SCHEM, TABLE_NAME, ORDINAL_POSITION
SQL
  # Rule 19:
  my $sth = $dbh->prepare( $STMT ) or return undef;
  $sth->execute or return undef;
  return $sth;
}
# -----------------------------------------------------------------------------

my $dbh = Dbh->new;
for (0..1) {
  $dbh->{METADATA_ID} = $_;
  $dbh->column_info( undef       ,'sss',' "ttt" ',''   );
  $dbh->column_info( undef       ,'sss',' "ttt" ','""' );
  $dbh->column_info( '  "c"cc"  ','sss',  'ttt'  ,'ccc');
}