SQLExec ou Faire simplement du SQL dans du PERL

• Faire un framework utile
• Simplifier l’écriture de scripts (pour des extractions ou interactions),
• Regrouper les requêtes SQL et un algo dans un seul fichier.

La connexion a la base Oracle s’effectuera en fonction des variables d’environnements ‘USERID’ et ‘ORACLE_SID‘. Toute fois il est possible de surcharger ces paramètres avec les options suivantes :

Usage Oracle connection:
 ./mon_script.pl -u user -p passwd
 ./mon_script.pl -s oracle_sid
 ./mon_script.pl -u user -p passwd -s oracle_sid
 ./mon_script.pl -c user/passwd@oracle_sid

./mon_script.pl -h : print this message.
please read ./mon_script.pl for script arguments.

Ces options sont automatiquement géré dans le module.

Une fois instancié l’object SQLExec lit la deuxième partie du script (en dessous de ‘_DATA_‘) pour créer automatiquement des méthodes en fonction des requêtes SQL. Ces méthodes porteront le noms des balises utilisées. Exemple :

<selectmytable>
SELECT COL1, COL2, COL3
FROM MY_TABLE
WHERE COL_1 <= ?
AND COL_2 = ?
ORDER BY COL_1
</selectmytable>

La méthode ‘selectmytable’ est automatiquement générer et peut être utilisée :

my $db = SQLExec->new();
$result = $db->selectmytable(-1000, 'FR');

Ce script liste les tables dont le nom, ou les commentaires contiennent la chaîne passée en paramètres.

#!/usr/bin/perl -w
 
use strict;
use SQLExec;
 
my $db = SQLExec->new();
push @ARGV, '' unless @ARGV;
while (@ARGV) {
  my $name = uc(shift);
  my $array = [];
  $array = $db->search_tablename($name);
  unless (@$array){
    $array = $db->search_tablecomments($name);
  }
  foreach my $line (@$array) {
    my $tmp = $^A;
    ${$line}[1] = "(No comments)" unless defined ${$line}[1];
    my $str = formline <<'FORMOUT', @$line ;
@<<<<<<<<<<<<<<<<<<< @*
FORMOUT
    print $^A;
    $^A = $tmp;
  }
}
 
__DATA__
<search_tablename>
SELECT table_name, comments
FROM user_tab_comments
WHERE UPPER(table_name) LIKE ('%'||?||'%')
ORDER BY table_name
</search_tablename>
 
<search_tablecomments>
SELECT table_name, comments
FROM user_tab_comments
WHERE UPPER(comments) LIKE ('%'||?||'%')
ORDER BY table_name
</search_tablecomments>

Fichier SQLExec.pm :

package SQLExec;
use DBI;
use Getopt::Std;
 
BEGIN {
  my $opts = {};
  getopts('u:p:s:c:h', $opts);
  if (defined $opts->{c}) {
    my ($userid, $sid) = split '@', $opts->{c};
    $opts->{s} = $sid;
    $ENV{USERID} = $userid;
  }
  if (defined $opts->{u}) {
   $opts->{h} = 1 unless defined $opts->{p};
  }
  if (defined $opts->{p}) {
   $opts->{h} = 1 unless defined $opts->{u};
  }
  if (defined $opts->{s}) {
    $ENV{ORACLE_SID} = $opts->{s};
  }
  if (defined $opts->{h}) {
    print <<EOL;
Usage Oracle connection:
 $0 -u user -p passwd
 $0 -s oracle_sid
 $0 -u user -p passwd -s oracle_sid
 $0 -c user/passwd\@oracle_sid
 
$0 -h : print this message.
please read $0 for script arguments.
EOL
    exit (-1);
  }
  if (defined $opts->{p} and defined $opts->{u}) {
    $ENV{USERID} = "$opts->{u}/$opts->{p}";
  }
}
 
sub new {
  my $class = shift;
  my %params = @_;
  $self = {
	   sid => $ENV{ORACLE_SID},
	   userid => $ENV{USERID},
	   datahdl => *::DATA,
	  };
  for my $args (keys %params) {
    $self->{$args} = $params{$args};
  }
  bless $self, $class;
  $self->dbconnect();
  return $self;
}
 
 
sub preparesql {
  my $self = shift;
  my $sql = {};
  my $req = '';
  my $fh = $self->{datahdl};
  while (<$fh>) {
    chomp;
    next if (/^$/);
    next if (/^#$/);
    if (/^<([^\/].*)>$/) {
      $req = $1;
      $sql->{$req} = '';
      next;
    }
    if (/^<(\/.*)>$/) {
      $req = '';
      next;
    }
    unless ($req eq '') {
      $sql->{$req} .= $_ . ' ';
    }
  }
  foreach my $k (keys %{$sql}) {
    $self->{sql}->{$k} = $self->{dbh}->prepare($sql->{$k});
  }
}
 
sub dbexecute {
  my $self = shift;
  my $sql_name = shift;
  my $sth = $self->{sql}->{$sql_name};
  my $rv = $sth->execute(@_);
  $sth->fetchall_arrayref();
}
 
sub dbconnect {
  my $self = shift;
  my $dbh = DBI->connect("dbi:Oracle:$self->{sid}",
			 "$self->{userid}", '')
    or die "Unable to connect: $DBI::errstr\n";
  $self->{dbh} = $dbh;
  $self->preparesql();
}
 
sub DESTROY {
  my $self = shift;
 
}
 
sub AUTOLOAD {
  my $self = shift;
  my $name = '';
  if ($AUTOLOAD =~ /^.*?::(.*)$/) {
    $name = $1;
  }
  if (defined $self->{sql}->{$name}) {
    return $self->dbexecute($name, @_);
  }
  die "Unknown method : $name\n";
}
 
1;