DBI mysql - tout avec des hashes (tableaux associatifs)
Bon, dans la série "je réinvente la roue", mais si je l'ai réinventée, c'est que je n'ai trouvé que des bribes du "carrosse" dans la FAQ et auprès de mon ami, donc voilà quelques fonctions utiles sur la base de l'utilisation du module DBI et des tableaux associatifs :
Testé sur Perl V5.10 / Debian Lenny
Entête commune :
Code:
1 2 3 4 5 6 7 8 9 10 11 12
| #!/usr/bin/perl -w
use strict;
use warnings;
use DBI;
use DBD::mysql; # hum, redondant avec DBI?
use constant true => 1;
use constant TRUE => 1;
use constant false => 0;
use constant FALSE => 0;
use constant DEBUG => true; |
CONNEXION/DECONNEXION
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
| sub db_connect {
# local params
my ($db_name, $host, $db_user, $db_pwd) = @_ ;
# Connect
my $dbh = DBI->connect("dbi:mysql:dbname=$db_name;host=$host;mysql_server_prepare=1;",$db_user, $db_pwd)
or die "err " . $dbh->err;
# mysql setup
$dbh->{mysql_bind_type_guessing} = TRUE;
$dbh->{ChopBlanks} = TRUE;
$dbh->{RaiseError} = TRUE if DEBUG;
return $dbh;
} |
Code:
1 2 3 4 5 6 7 8
| sub db_disconnect{
my ($local_dbh) = @_ ;
if ($local_dbh->disconnect) {
return TRUE;
} else {
return FALSE;
}
} |
INSERT
Code:
1 2 3 4 5 6 7 8 9 10
| sub db_insert_hash {
my ($dbh, $table, $field_values) = @_;
my @fields = sort keys %$field_values;
my @values = @{$field_values}{@fields};
my $sql = sprintf "INSERT INTO %s (%s) VALUES (%s)", $table, join(",", @fields), join(",", ("?") x @fields);
# ^^ ^^ ^^
# table columns binded values
my $sth = $dbh->prepare($sql);
return $sth->execute(@values);
} |
UPDATE
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28
| sub db_update_hash {
# INIT
my ($dbh, $table, $field_values, $sql_condition) = @_;
# CORE QUERY
my @fields = sort keys %$field_values;
my @values = @{$field_values}{@fields};
my $query = sprintf "UPDATE %s SET %s " , $table, join ( ", ", map { "$_=?" } @fields ) ;
# WHERE CONDITION
my @condition_fields = sort keys %$sql_condition;
my @condition_values = @{$sql_condition}{@condition_fields};
my $qualifier = "";
$qualifier = "WHERE " . join(" AND ", map { "$_=?" } @condition_fields) if @condition_fields;
# FINAL QUERY
$query .= $qualifier ;
# PREPARE
my $sth = $dbh->prepare($query);
# BIND ARRAY: merge both data arrays (values and conditions)
push @values, @condition_values;
# EXECUTE
return $sth->execute(@values);
} |
SEARCH
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
| sub db_search_hash {
my ($dbh, $table, $field_values) = @_;
# INIT: split input datas hash into 2 arrays
my @fields = sort keys %$field_values;
my @values = @{$field_values}{@fields};
# WHERE CONDITION
my $qualifier = "";
$qualifier = "WHERE ".join(" and ", map { "$_=?" } @fields) if @fields;
# CORE QUERY
my $query = "SELECT * FROM $table $qualifier" ;
# PREPARE
my $sth = $dbh->prepare($query);
# EXECUTE
return $dbh->selectall_hashref($sth, \@fields, {}, @values);
} |
HASH RECURSIVE KEY SEARCH, en complément à db_search_hash qui renvoie un hash dans lequel on devra farfouiller
Code:
1 2 3 4 5 6 7 8 9 10 11
| sub hash_recursive_key_search {
my ( $needle_key, %hash ) = @_ ;
my $found ;
while ( my ($key, $value) = each %hash ) {
$found = ( $key eq $needle_key) ? "(*)" : "";
print "key: $key => value: $value $found\n" if ( ref $value ne 'HASH' and DEBUG);
push @$tmp, $key, $value if ( $key eq $needle_key) ;
&hash_recursive_key_search( $needle_key, %$value ) if ( ref $value eq 'HASH') ;
}
} |
Exemple d'utilisation
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
| # CONNEXION
my $db_handle = &connect_db ($db_name, $host, $db_user, $db_pwd); # à vous de renseigner
# DATAS
my $table = "foo" ;
my $client_id = "12345" ;
my $pn ="AB1234";
my $hash = {'id_client' => $client_id , 'serial_number' => $pn , status => 1} ;
# INSERT
my $db_insert = &db_insert_hash ($db_handle, $table, $hash ) ;
#UPDATE
my $sql_condition = {"id_client" => $client_id, "serial_number" => $pn} ;
my $field_values = { status => 2 };
my $update = &db_update_hash ($dbh, $table, $field_values, $sql_condition) ;
# SEARCH
my $result = &db_search_hash ($dbh, $table, $sql_condition) ;
my $tmp = [] ;
my $needle_key = "id";
&hash_recursive_key_search( $needle_key , %$result ) ;
my $id_key = @$tmp[0] ;
my $id_value = @$tmp[1] ;
#DECONNEXION
&db_disconnect($db_handle); |
Récupération d'une page Web
Voici un script permettant de récupérer le contenu d'une page Web.
J'ai ajouté la possibilité de spécifier un proxy HTTP. Ainsi qu'un login pour les connexion HTTP (autorisation de base).
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
|
use warnings;
use strict;
use Getopt::Long;
use LWP::Simple;
require LWP::UserAgent;
use MIME::Base64;
=begin COMM
Script permettant de recuperer le contenu du page web en HTTP avec utilisation d'un proxy et d'un login si besoin.
Arguments obligatoires :
--url=URL
Precise la page a recuperer
Arguments Optionnels :
--login=USER:PASSWD
Specifie le login a utiliser
--proxy=PROXY
Indiquer un proxy HTTP
=end COMM
=cut
my ($url, $login, $proxy) = (undef);
GetOptions("url=s" => \$url, "login=s" => \$login, "proxy=s" => \$proxy); # Recuperation et stockage des options dans leurs variables respectives
die ("Usage : ".$0." --url=URL\n") if (!defined($url)); # Le script a besoin d'au moins une URL pour fonctionner
die ("Usage : ".$0." --url=URL --login=USER:PASSWD\n") if (defined($login) and $login !~ /.+:.+/); # Le login doit etre forme du nom et du mot de passe separes par deux points
my $ua = LWP::UserAgent->new; # Creation du User Agent. Il se charge de traiter la requete HTTP, comme un navigateur le ferait.
$ua->timeout(20); # Le timeout permet de savoir a partir de quand on considere qu'un requete n'aboutira pas
my $req = HTTP::Request->new( GET => $url ); # On crée la requete HTTP correspondant a l'url
if (defined($proxy)) {
$ua->env_proxy; # Indique a l'user agent qu'il va devoir utiliser un proxy
$ua->proxy(['http'], $proxy); # Indique a l'user agent quel proxy utiliser
}
if (defined($login)) {
my $token = encode_base64($login); # Encodage en base 64 comme le demande HTTP
$req->header( Authorization => "Basic ".$token ); # Ajout de l'option 'Authorization Basic' et du login dans la requete. (cf RFC de HTTP)
}
my $content = $ua->request($req); # Envoi de la requete et reception de la reponse dans $content
if ($content->is_success) {
print $content->decoded_content; # Si la requete a abouti, afficher le contenu de la page web
} else {
die $content->status_line; # Afficher la raison de l'erreur
} |
Insertion des données à partir d'un fichier
Bonjour,
Voila, je vous mets ici un code permettant de remplir une table de données à partir d'un fichier texte. Le SGBDR utilisé est Mysql server.
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13
|
# Insertion des données
my $file_database = "fichier.txt";
my $RequeteSQL = <<"SQL";
LOAD DATA LOCAL INFILE '$file_database'
REPLACE
INTO TABLE [Nom_table]
FIELDS
TERMINATED BY '\t' #Les données sont séparées par des tabulations.
LINES
TERMINATED BY '\n' #Chaque ligne se termine par \n.
SQL
$dbh->do($RequeteSQL) or die "Echec Requete $RequeteSQL : $DBI::errstr"; |