home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Statement.pm < prev    next >
Encoding:
Perl POD Document  |  2002-01-07  |  4.0 KB  |  172 lines
  1. # -*- perl -*-
  2.  
  3. package Mysql::Statement;
  4.  
  5. @Mysql::Statement::ISA = qw(DBI::st);
  6.  
  7. use strict;
  8. use vars qw($VERSION $AUTOLOAD);
  9.  
  10. $VERSION = '1.2401';
  11.  
  12. sub fetchrow ($) {
  13.     my $self = shift;
  14.     my $ref = $self->fetchrow_arrayref;
  15.     if ($ref) {
  16.     wantarray ? @$ref : $ref->[0];
  17.     } else {
  18.     ();
  19.     }
  20. }
  21. sub fetchhash ($) {
  22.     my($self) = shift;
  23.     my($ref) = $self->fetchrow_hashref;
  24.     if ($ref) {
  25.     %$ref;
  26.     } else {
  27.     ();
  28.     }
  29. }
  30. sub fetchcol ($$) {
  31.     my($self, $colNum) = @_;
  32.     my(@col);
  33.     $self->dataseek(0);
  34.     my($ref);
  35.     while ($ref = $self->fetchrow_arrayref) {
  36.     push(@col, $ref->[$colNum]);
  37.     }
  38.     @col;
  39. }
  40. sub dataseek ($$) {
  41.     my($self, $pos) = @_;
  42.     $self->func($pos, 'dataseek');
  43. }
  44.  
  45. sub numrows { my($self) = shift; $self->rows() }
  46. sub numfields { my($self) = shift; $self->{'NUM_OF_FIELDS'} }
  47. sub arrAttr ($$) {
  48.     my($self, $attr) = @_;
  49.     my $arr = $self->{$attr};
  50.     wantarray ? @$arr : $arr
  51. }
  52. sub table ($) { shift->arrAttr('mysql_table') }
  53. sub name ($) { shift->arrAttr('NAME') }
  54. *affectedrows = \&numrows;
  55. sub insertid { my($self) = shift; $self->{'mysql_insertid'} }
  56. sub type ($) { shift->arrAttr('mysql_type') }
  57. sub isnotnull ($) {
  58.     my $arr = [map {!$_} @{shift()->{'NULLABLE'}}];
  59.     wantarray ? @$arr : $arr;
  60. }
  61. sub isprikey ($) { shift->arrAttr('mysql_is_pri_key') }
  62. sub isnum ($) { shift->arrAttr('mysql_is_num') }
  63. sub isblob ($) { shift->arrAttr('mysql_is_blob') }
  64. sub length ($) { shift->arrAttr('PRECISION') }
  65.  
  66. sub maxlength  {
  67.     my $sth = shift;
  68.     my $result;
  69.     if (!($result = $sth->{'mysql_maxlength'})) {
  70.     $result = [];
  71.     for (my $i = 0;  $i < $sth->numfields();  $i++) {
  72.         $result->[$i] = 0;
  73.     }
  74.     $sth->dataseek(0);
  75.     my $numRows = $sth->numrows();
  76.     for (my $j = 0;  $j < $numRows;  $j++) {
  77.         my @row = $sth->fetchrow;
  78.         for (my $i = 0;  $i < @row;  $i++) {
  79.         my $col = $row[$i];
  80.         my $s;
  81.         if (defined($col)) {
  82.             $s = unctrl($col);
  83.             my $l = CORE::length($s);
  84.             # New in 2.0: a string is longer than it should be
  85.             if (defined &Msql::TEXT_TYPE  &&
  86.             $sth->type->[$i] == &Msql::TEXT_TYPE  &&
  87.             $l > $sth->length->[$i] + 5) {
  88.             substr($s,$sth->length->[$i]) = "...($l)";
  89.             $l = CORE::length($s);
  90.             }
  91.             $result->[$i] = $l if $l > $result->[$i];
  92.         } else {
  93.             $s = "NULL";
  94.         }
  95.         }
  96.     }
  97.     $sth->dataseek(0);
  98.     }
  99.     return wantarray ? @$result : $result;
  100. }
  101.  
  102. sub listindices {
  103.     my($sth) = shift;
  104.     my(@result,$i);
  105.     return ();
  106. }
  107.  
  108. sub AUTOLOAD {
  109.     my $meth = $AUTOLOAD;
  110.     $meth =~ s/^.*:://;
  111.     $meth =~ s/_//g;
  112.     $meth = lc($meth);
  113.  
  114.     # Allow them to say fetch_row or FetchRow
  115.     no strict;
  116.     if (defined &$meth) {
  117.     *$AUTOLOAD = \&{$meth};
  118.     return &$AUTOLOAD(@_);
  119.     }
  120.     Carp::croak ("$AUTOLOAD not defined and not autoloadable");
  121. }
  122.  
  123. sub unctrl {
  124.     my($x) = @_;
  125.     $x =~ s/\\/\\\\/g;
  126.     $x =~ s/([\001-\037\177])/sprintf("\\%03o",unpack("C",$1))/eg;
  127.     $x;
  128. }
  129.  
  130.  
  131. sub as_string {
  132.     my($sth) = @_;
  133.     my($plusline,$titline,$sprintf) = ('+','|','|');
  134.     my($result,$s,$l);
  135.     if ($sth->numfields == 0) {
  136.     return '';
  137.     }
  138.     for (0..$sth->numfields-1) {
  139.     $l=CORE::length($sth->name->[$_]);
  140.     if ($l < $sth->maxlength->[$_]) {
  141.         $l= $sth->maxlength->[$_];
  142.     }
  143.     if (!$sth->isnotnull  &&  $l < 4) {
  144.         $l = 4;
  145.     }
  146.     $plusline .= sprintf "%$ {l}s+", "-" x $l;
  147.     $l= -$l  if (!$sth->isnum->[$_]);
  148.     $titline .= sprintf "%$ {l}s|", $sth->name->[$_];
  149.     $sprintf .= "%$ {l}s|";
  150.     }
  151.     $sprintf .= "\n";
  152.     $result = "$plusline\n$titline\n$plusline\n";
  153.     $sth->dataseek(0);
  154.     my(@row);
  155.     while (@row = $sth->fetchrow) {
  156.     my ($col, $pcol, @prow, $i, $j);
  157.     for ($i = 0;  $i < $sth->numfields;  $i++) {
  158.         $col = $row[$i];
  159.         $j = @prow;
  160.         $pcol = defined $col ? unctrl($col) : "NULL";
  161.         push(@prow, $pcol);
  162.     }
  163.     $result .= sprintf $sprintf, @prow;
  164.     }
  165.     $result .= "$plusline\n";
  166.     $s = $sth->numrows == 1 ? "" : "s";
  167.     $result .= $sth->numrows . " row$s processed\n\n";
  168.     return $result;
  169. }
  170.  
  171. 1;
  172.