[Summary view] [Print] [Text view]

   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 
  47  {
  48    my ($self) = @_;
  49    return defined $self->{'NUM_OF_FIELDS'} ? $self->{'NUM_OF_FIELDS'} : 0;
  50  }
  51  sub arrAttr ($$) {
  52      my($self, $attr) = @_;
  53      my $arr = $self->{$attr};
  54      wantarray ? @$arr : $arr
  55  }
  56  sub table ($) { shift->arrAttr('mysql_table') }
  57  sub name ($) { shift->arrAttr('NAME') }
  58  *affectedrows = \&numrows;
  59  sub insertid { my($self) = shift; $self->{'mysql_insertid'} }
  60  sub type ($) { shift->arrAttr('mysql_type') }
  61  sub isnotnull ($) {
  62      my $arr = [map {!$_} @{shift()->{'NULLABLE'}}];
  63      wantarray ? @$arr : $arr;
  64  }
  65  sub isprikey ($) { shift->arrAttr('mysql_is_pri_key') }
  66  sub isnum ($) { shift->arrAttr('mysql_is_num') }
  67  sub isblob ($) { shift->arrAttr('mysql_is_blob') }
  68  sub length ($) { shift->arrAttr('PRECISION') }
  69  
  70  sub maxlength  {
  71      my $sth = shift;
  72      my $result;
  73      if (!($result = $sth->{'mysql_maxlength'})) {
  74      $result = [];
  75      for (my $i = 0;  $i < $sth->numfields();  $i++) {
  76          $result->[$i] = 0;
  77      }
  78      $sth->dataseek(0);
  79      my $numRows = $sth->numrows();
  80      for (my $j = 0;  $j < $numRows;  $j++) {
  81          my @row = $sth->fetchrow;
  82          for (my $i = 0;  $i < @row;  $i++) {
  83          my $col = $row[$i];
  84          my $s;
  85          if (defined($col)) {
  86              $s = unctrl($col);
  87              my $l = CORE::length($s);
  88              # New in 2.0: a string is longer than it should be
  89              if (defined &Msql::TEXT_TYPE  &&
  90              $sth->type->[$i] == &Msql::TEXT_TYPE  &&
  91              $l > $sth->length->[$i] + 5) {
  92              substr($s,$sth->length->[$i]) = "...($l)";
  93              $l = CORE::length($s);
  94              }
  95              $result->[$i] = $l if $l > $result->[$i];
  96          } else {
  97              $s = "NULL";
  98          }
  99          }
 100      }
 101      $sth->dataseek(0);
 102      }
 103      return wantarray ? @$result : $result;
 104  }
 105  
 106  sub listindices {
 107      my($sth) = shift;
 108      my(@result,$i);
 109      return ();
 110  }
 111  
 112  sub AUTOLOAD {
 113      my $meth = $AUTOLOAD;
 114      $meth =~ s/^.*:://;
 115      $meth =~ s/_//g;
 116      $meth = lc($meth);
 117  
 118      # Allow them to say fetch_row or FetchRow
 119      no strict;
 120      if (defined &$meth) {
 121      *$AUTOLOAD = \&{$meth};
 122      return &$AUTOLOAD(@_);
 123      }
 124      Carp::croak ("$AUTOLOAD not defined and not autoloadable");
 125  }
 126  
 127  sub unctrl {
 128      my($x) = @_;
 129      $x =~ s/\\/\\\\/g;
 130      $x =~ s/([\001-\037\177])/sprintf("\\%03o",unpack("C",$1))/eg;
 131      $x;
 132  }
 133  
 134  
 135  sub as_string {
 136      my($sth) = @_;
 137      my($plusline,$titline,$sprintf) = ('+','|','|');
 138      my($result,$s,$l);
 139      if ($sth->numfields == 0) {
 140      return '';
 141      }
 142      for (0..$sth->numfields-1) {
 143      $l=CORE::length($sth->name->[$_]);
 144      if ($l < $sth->maxlength->[$_]) {
 145          $l= $sth->maxlength->[$_];
 146      }
 147      if (!$sth->isnotnull  &&  $l < 4) {
 148          $l = 4;
 149      }
 150      $plusline .= sprintf "%$ {l}s+", "-" x $l;
 151      $l= -$l  if (!$sth->isnum->[$_]);
 152      $titline .= sprintf "%$ {l}s|", $sth->name->[$_];
 153      $sprintf .= "%$ {l}s|";
 154      }
 155      $sprintf .= "\n";
 156      $result = "$plusline\n$titline\n$plusline\n";
 157      $sth->dataseek(0);
 158      my(@row);
 159      while (@row = $sth->fetchrow) {
 160      my ($col, $pcol, @prow, $i, $j);
 161      for ($i = 0;  $i < $sth->numfields;  $i++) {
 162          $col = $row[$i];
 163          $j = @prow;
 164          $pcol = defined $col ? unctrl($col) : "NULL";
 165          push(@prow, $pcol);
 166      }
 167      $result .= sprintf $sprintf, @prow;
 168      }
 169      $result .= "$plusline\n";
 170      $s = $sth->numrows == 1 ? "" : "s";
 171      $result .= $sth->numrows . " row$s processed\n\n";
 172      return $result;
 173  }
 174  
 175  1;