Perl et les bases de données (DBI)

/*    Création de la base de données France2013 */
CREATE DATABASE `France2013`;

C:\>mysql -u root -p
Enter password: *****
Welcome to the MySQL monitor.  Commands end with ; or \g.
Your MySQL connection id is 25
Server version: 5.1.31-community MySQL Community Server (GPL)

Type 'help;' or '\h' for help. Type '\c' to clear the buffer.

mysql> CREATE DATABASE `France2013`;
Query OK, 1 row affected (0.04 sec)

#!/usr/bin/perl
#========================================================================================
# Auteur : djibril
# But     : Création des tables SQL et insertion de données
#
# http://djibril.developpez.com/tutoriels/perl/perl-dbi/
#========================================================================================
use warnings;
use strict;
use Encode;
use utf8;
use DBI;            # Charger le module DBI
use vars qw/ $VERSION /;    # Version du script
$VERSION = '1.0';

ActiverAccents();

# Paramètres de connection à la base de données
my $bd        = 'France2013';
my $serveur    = 'localhost'; # Il est possible de mettre une adresse IP
my $identifiant = 'root';      # identifiant 
my $motdepasse    = '';
my $port    = '';        #Si vous ne savez pas, ne rien mettre

# Connection à la base de données mysql
print "Connexion à la base de données $bd\n";
my $dbh = DBI->connect( "DBI:mysql:database=$bd;host=$serveur;port=$port", 
    $identifiant, $motdepasse, { 
    RaiseError => 1,
    }  
) or die "Connection impossible à la base de données $bd !\n $! \n $@\n$DBI::errstr";

# Création des tables
print "Création de la table Regions\n";
my $sql_creation_table_regions = <<"SQL";
CREATE TABLE Regions (
  id_region INT         NOT NULL ,
  cheflieu  VARCHAR( 6 )    NOT NULL ,
  tncc        INT         NOT NULL ,
  ncc        VARCHAR( 100 )  NOT NULL ,
  nccenr    VARCHAR( 100 )  NOT NULL ,
  PRIMARY KEY ( id_region )
)  COMMENT = 'LES REGIONS 2013 EN FRANCE';
SQL

$dbh->do('DROP TABLE IF EXISTS Regions;') or die "Impossible de supprimer la table Regions\n\n";
$dbh->do($sql_creation_table_regions) or die "Impossible de créer la table Regions\n\n";

print "Création de la table Communes\n";
my $sql_creation_table_communes = <<"SQL";
CREATE TABLE Communes (
  id_communes      INT          NOT NULL AUTO_INCREMENT PRIMARY KEY COMMENT 'Elle sera générée automatiquement.',
  cdc          INT          NOT NULL ,
  cheflieu      VARCHAR( 6 )      NOT NULL ,
  id_region      INT          NOT NULL ,
  id_departement  VARCHAR( 10 )   NOT NULL ,
  com          INT          NOT NULL ,
  ar          INT          NOT NULL ,
  ct          INT          NOT NULL ,
  tncc          INT          NOT NULL ,
  artmaj      VARCHAR( 20 )   ,
  ncc          VARCHAR( 100 )  NOT NULL ,
  artmin      VARCHAR( 20 )   ,
  nccenr      VARCHAR( 100 )  NOT NULL
) COMMENT = 'LES COMMUNES 2013 EN FRANCE';
SQL

$dbh->do('DROP TABLE IF EXISTS Communes;') or die "Impossible de supprimer la table Communes\n\n";
$dbh->do($sql_creation_table_communes) or die "Impossible de créer la table Communes\n\n";

print "Création de la table Departements\n";
my $sql_creation_table_departements = <<"SQL";
CREATE TABLE Departements  (
  id_departement  VARCHAR( 10 )   NOT NULL COMMENT 'les valeurs sont uniques',
  id_region      INT          NOT NULL ,
  cheflieu      VARCHAR( 6 )      NOT NULL ,
  tncc          INT          NOT NULL ,
  ncc          VARCHAR( 100 )  NOT NULL ,
  nccenr      VARCHAR( 100 )  NOT NULL ,
  PRIMARY KEY ( id_departement )
) COMMENT = 'LES DEPARTEMENTS 2013 EN FRANCE';
SQL

$dbh->do('DROP TABLE IF EXISTS Departements;') or die "Impossible de supprimer la table Departements\n\n";
$dbh->do($sql_creation_table_departements) or die "Impossible de créer la table Departements\n\n";

# Lecture des fichiers et insertion des données
my $fichier_regions     = 'reg2013.txt';
my $fichier_communes     = 'comsimp2013.txt';
my $fichier_departements = 'depts2013.txt';

# Fichier Region
print "Insertion des données dans la table regions\n";
open my $fh_regions, '<:encoding(UTF-8)', $fichier_regions or die "Impossible de lire le fichier $fichier_regions\n";
my $entete_fichier_region = <$fh_regions>;

# Insertion des données
my $requete_sql_region = <<"SQL";
  INSERT INTO regions ( id_region, cheflieu, tncc, ncc, nccenr )
  VALUES ( ?, ?, ?, ?, ? );
SQL

my $sth_regions = $dbh->prepare($requete_sql_region);

while ( my $ligne = <$fh_regions> ) {
  chomp $ligne;
  my ( $REGION, $CHEFLIEU, $TNCC, $NCC, $NCCENR ) = split /\t/, $ligne;
  $sth_regions->execute( $REGION, $CHEFLIEU, $TNCC, encode('latin1',$NCC), encode('latin1',$NCCENR) )
    or die "Echec Requ&#234;te $requete_sql_region : $DBI::errstr";
}
close $fh_regions;

# Fichier Communes
print "Insertion des données dans la table Communes\n";
open my $fh_communes, '<:encoding(UTF-8)', $fichier_communes or die "Impossible de lire le fichier $fichier_communes\n";
my $entete_fichier_communes = <$fh_communes>;

# Insertion des données
my $requete_sql_communes = <<"SQL";
  INSERT INTO communes ( 
    id_communes, cdc,         cheflieu, 
    id_region,     id_departement, com, 
    ar,      ct,         tncc, 
    artmaj,     ncc,         artmin,
    nccenr )
  VALUES ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? );
SQL

my $sth_communes = $dbh->prepare($requete_sql_communes);
while ( my $ligne = <$fh_communes> ) {
  chomp $ligne;
  my ( $CDC, $CHEFLIEU, $REG, $DEP, $COM, $AR, $CT, $TNCC, $ARTMAJ, $NCC, $ARTMIN, $NCCENR ) = split /\t/,
    $ligne;

  $sth_communes->execute( undef, $CDC, $CHEFLIEU, $REG, $DEP, $COM, $AR, $CT, $TNCC, $ARTMAJ, $NCC, encode('latin1',$ARTMIN),
    encode('latin1',$NCCENR) )
    or die "Echec Requ&#234;te $requete_sql_communes : $DBI::errstr";
}
close $fh_communes;

# Fichier Departements
print "Insertion des données dans la table Departements\n";
open my $fh_departements, '<:encoding(UTF-8)', $fichier_departements
  or die "Impossible de lire le fichier $fichier_departements\n";
my $entete_fichier_departements = <$fh_departements>;

# Insertion des données
my $requete_sql_departement = <<"SQL";
  INSERT INTO Departements ( 
    id_departement, id_region, cheflieu, 
    tncc,        ncc,       nccenr )
  VALUES ( ?, ?, ?, ?, ?, ? );
SQL

my $sth_departements = $dbh->prepare($requete_sql_departement);
while ( my $ligne = <$fh_departements> ) {
  chomp $ligne;
  my ( $REGION, $DEP, $CHEFLIEU, $TNCC, $NCC, $NCCENR ) = split /\t/, $ligne;
  $sth_departements->execute( $DEP, $REGION, $CHEFLIEU, $TNCC, $NCC, encode('latin1',$NCCENR) )
    or die "Echec Requ&#234;te $requete_sql_departement : $DBI::errstr";
}
close $fh_departements;

# Déconnection de la base de données
$dbh->disconnect();

#==============================================================
# Pour avoir les accents sur la console DOS ou non
# https://perl.developpez.com/faq/perl/?page=Terminal#Accents
#==============================================================
sub ActiverAccents {
    my $encodage;
    # Windows
      if ( lc($^O ) eq 'mswin32') {
    eval {
        my ($codepage) = ( `chcp` =~ m/:\s+(\d+)/ );
        $encodage = "cp$codepage";
        foreach my $h ( \*STDOUT, \*STDERR, \*STDIN, ) {
        binmode $h, ":encoding($encodage)";
        }
    };
    }
    else {
    $encodage = `locale charmap`;
    eval {
        foreach my $h ( \*STDOUT, \*STDERR, \*STDIN, ) {
        binmode $h, ":encoding($encodage)";
        }
    };
    }
  return $encodage;
}

ActiverAccents();

# Connection à la base de données  PostgreSQL
print "Connexion à la base de données $bd\n";
my $dbh = DBI->connect( "DBI:Pg:database=$bd;host=$serveur;port=$port", 
    $identifiant, $motdepasse, { 
    RaiseError => 1,
    }  
) or die "Connection impossible à la base de données $bd !\n $! \n $@\n$DBI::errstr";

id_communes  INT   NOT NULL AUTO_INCREMENT PRIMARY KEY COMMENT 'Elle sera générée automatiquement.',

  INSERT INTO communes ( 
    id_communes, cdc,         cheflieu, 
    id_region,     id_departement, com, 
    ar,      ct,         tncc, 
    artmaj,     ncc,         artmin,
    nccenr )
  VALUES ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? );

  $sth_communes->execute( undef, $CDC, $CHEFLIEU, $REG, $DEP, $COM, $AR, $CT, $TNCC, $ARTMAJ, $NCC,
        encode('latin1',$ARTMIN), encode('latin1',$NCCENR) )
    or die "Echec Requête $requete_sql_communes : $DBI::errstr";

#!/usr/bin/perl
#==========================================================================
# Auteur : djibril
# But     : Interrogation de ma base de données
#==========================================================================
use warnings;
use strict;

use DBI;    
use Term::UI;
use Term::ReadLine;
use Encode;
use utf8;

use vars qw/ $VERSION /;    # Version du script
$VERSION = '1.0';

my $encodage = ActiverAccents();

# Paramètres de connection à la base de données
my $bd        = 'France2013';
my $serveur    = 'localhost';      # Il est possible de mettre une adresse IP
my $identifiant = 'root';      # identifiant 
my $motdepasse    = '';
my $port    = '';

# Connection à la base de données mysql
print "Connexion à la base de données $bd\n";
my $dbh = DBI->connect( "DBI:mysql:database=$bd;host=$serveur;port=$port", 
    $identifiant, $motdepasse, { 
    RaiseError => 1,
    }  
) or die "Connection impossible à la base de données $bd !\n $! \n $@\n$DBI::errstr";

#!/usr/bin/perl
#==========================================================================
# Auteur : djibril
# But     : Création des tables SQL et insertion de données
#
# http://djibril.developpez.com/tutoriels/perl/perl-dbi/
#
# Quelques modifs mineures par dmganges pour Oracle :
# - Connexion à BDD
# - Oracle renvoie les noms des colonnes en MAJUSCULES ce qui implique
#     dans les selectrow_hashref par ex :
#         $ref_commune->{'NBRCOMMUNES'} au lieu de $ref_commune->{NbrCommunes}
#   Ainsi que dand les clause AS
#         SELECT COUNT( id_communes ) as NBRCOMMUNES
#    - Modif des clauses LIKE avec ? pour méthode $sth->bind_columns
#==========================================================================
use warnings;
use strict;
use utf8;
use DBI;                      # Charge le module DBI
use DBI qw(:sql_types);               # Pour utiliser les types du genre SQL_VARCHAR
use Term::UI;                      # Pour interaction avec la console
use Term::ReadLine;                  # Pour interaction avec la console

use vars qw/ $VERSION /;              # Version du script
$VERSION = '1.0';

ActiverAccents();

# Paramètres de connexion à la base de données
my $host = "localhost";
my $port = "1521";
my $bdd  = "XE";
my $user = "michel";
my $pass = "michel";

my $dbh = DBI->connect("dbi:Oracle:host=$host;port=$port;sid=$bdd", $user, $pass, {
    PrintError => 0,
    AutoCommit => 0
}) or die "\nERR=Connexion impossible à la base de données $bdd\n $! \n $@\n$DBI::errstr";

my ($Sysdate) = $dbh->selectrow_array("SELECT sysdate FROM dual")
    or die "\nERR=Sysdate\n $! \n $@\n$DBI::errstr";
print "Base OK Date = $Sysdate\n\n";

# 1 - Récupération de toutes les régions de France
my @Regions = &obtenir_region_france($dbh);
foreach my $Region ( @Regions ) {
    print "$Region\n";
}

#===========================================
# Lister tous les départements d'une région
#===========================================
# 2 - Choix de l'utilisateur
my $term           = Term::ReadLine->new('brand');
my $nom_region_choisie = $term->get_reply(
  print_me => "1- Listons tous les départements d'une région",
  prompt   => "Choisissez une r\x82gion de France : ",
  choices  => \@Regions,
  default  => 'PICARDIE',
);

# 3 - Récupération de tous les départements - méthode $sth->bind_columns
afficher_departement_dune_region( $dbh, $nom_region_choisie );

# 4- Afficher le nom du département, de la région et le nombre de
# communes en fonction d'un numéro de département - méthode selectrow_array
# nombre de communes - méthode selectrow_hashref
my $numero_departement = $term->get_reply(
  print_me =>
    "\n2- Trouvons le nom d'un département, de la région et le nombre de communes à partir d'un numéro de département",
  prompt  => "Donnez un num\x82ro de d\x82partement  :",
  default => 75,
);

afficher_informations_dun_departement( $dbh, $numero_departement );

# 5- Trouver le nom du département et de la région d'une commune donnée
my $commune = $term->get_reply(
  print_me => "\n3- Trouvons le nom du département et de la région d'une commune",
  prompt   => "Nom d'une commune : ",
  default  => 'GANGE',
);

# Les noms des communes (ncc) sont en majuscules dans la base
$commune = uc $commune;
# Les espaces dans les noms des communes sont remplacés par un tiret dans la base
$commune =~ s{\s}{-}g;
afficher_informations_dune_commune( $dbh, $commune );

print "\n\nFin consultation\n";
$dbh->disconnect() or die "\nERR=disconnect\n $! \n $@\n$DBI::errstr";

##############################################################################
# Procédure pour obtenir toutes les régions de France - méthode fetchrow_array
sub obtenir_region_france {
    my $dbh = shift;
    my @les_regions_france;
    my $sth = $dbh->prepare('SELECT ncc FROM Regions ORDER BY ncc')
    or die "\nERR=dbh->prepare\n $! \n $@\n$DBI::errstr";
    $sth->execute() or die "\nERR=execute\n $! \n $@\n$DBI::errstr";
    while ( my ($region) = $sth->fetchrow_array ) {
    push( @les_regions_france, $region );
    }
    $sth->finish() or die "\nERR=sth->finish\n $! \n $@\n$DBI::errstr";
    print "\n";
    return @les_regions_france;
} 

# Procédure pour afficher les départements d'une région
# Modifiée :
# - use DBI qw(:sql_types) Pour utiliser les types du genre SQL_VARCHAR
# - autre façon de construire la requête
# - suppression des clauses AS
# - passage d'un paramètre avec $sth->bind_param
# - récupération des colonnes dans l'ordre avec $sth->bind_columns directement dans my( $NomDep, $ChefLieu )

sub afficher_departement_dune_region {
    my ( $dbh, $nom_region_choisie ) = @_;
    my $Sql = qq{
    SELECT departements.nccenr, departements.cheflieu
    FROM departements, regions
    WHERE regions.id_region = departements.id_region
    AND regions.ncc LIKE ?
    };

    my $sth = $dbh->prepare($Sql) or die "\nERR=dbh->prepare\n $! \n $@\n$DBI::errstr";
    $sth->bind_param( 1, $nom_region_choisie, SQL_VARCHAR );
    my $rv = $sth->execute() or die "\nERR=execute\n $! \n $@\n$DBI::errstr";

    my( $NomDep, $ChefLieu );
  $sth->bind_columns( \$NomDep, \$ChefLieu ) or die "\nERR=sth->bind_columns\n $! \n $@\n$DBI::errstr";
    print "\n";
    while( $sth->fetch() ) {
    print (sprintf ( "%20s %8s \n", $NomDep, $ChefLieu ));
    }
    print "\nFIN\n";
    $sth->finish() or die "\nERR=sth->finish\n $! \n $@\n$DBI::errstr";
    return;
} 

# Procédure pour afficher toutes les informations d'un numéro de département 
sub afficher_informations_dun_departement { 
    my ( $dbh, $numero_departement ) = @_; 
    my $requete_dep_cheflieu_region = <<"SQL"; 
    SELECT  
    Departements.nccenr   AS NomDep,  
    Departements.cheflieu AS cheflieu, 
    Regions.ncc       AS NomRegion 
    FROM Departements 
    INNER JOIN Regions ON Regions.id_region = Departements.id_region 
    WHERE Departements.id_departement = '$numero_departement' 
SQL

    my $requete_nombre_commune = <<"SQL";
    SELECT COUNT(id_communes) as NbrCommunes
    FROM communes
    WHERE id_departement = '$numero_departement'
SQL

    my ( $nom_departement, $nom_cheflieu, $nom_region ) = $dbh->selectrow_array($requete_dep_cheflieu_region);
    print "\n";
    if ( defined $nom_cheflieu ) {
    print "\t - Numéro du département : $numero_departement\n";
    print "\t - Nom du département      : $nom_departement\n";
    print "\t - Nom du chef-lieu      : $nom_cheflieu\n";
    print "\t - Nom de la région      : $nom_region\n";

    # Calculer le nombre de communes
    # Nb Oracle renvoie les noms des colonnes en MAJUSCULES
    my ($ref_commune) = $dbh->selectrow_hashref($requete_nombre_commune) or die $dbh->errstr;
    print "\n\t - Nombre de communes    : ", $ref_commune->{'NBRCOMMUNES'}, "\n\n";

    # Ou, si on ne fait pas as NbrCommunes :
    # print "\t - Nombre de communes : ", $ref_commune->{'COUNT(ID_COMMUNES)'}, "\n\n";

    # Ou avec selectrow_array
    # my ($ref_commune) = $dbh->selectrow_array($requete_nombre_commune);
    # print "\n\t - Nombre de communes    : $ref_commune\n\n";
    } else {
    print "\nNuméro de département inconnu\n";
    }
    print "\nFIN\n";
    return;
}

# Procédure pour afficher toutes les informations d'une commune
sub afficher_informations_dune_commune {
  my ( $dbh, $commune ) = @_;
=pod
  my $requete_commune = <<"SQL";
    SELECT 
     Departements.id_departement    AS id_departement, 
     Departements.nccenr        AS NomDep, 
     Departements.cheflieu        AS cheflieu,
     Regions.ncc            AS NomRegion,
     Communes.ncc            AS commune
    FROM Communes
    INNER JOIN Regions ON Regions.id_region = Communes.id_region
    INNER JOIN Departements ON Departements.id_departement = Communes.id_departement
    WHERE Communes.ncc LIKE '%$commune%'
SQL
=cut

  my $requete_commune = <<"SQL";
  SELECT 
    Departements.id_departement    AS id_departement,
    a.ncc               AS commune, 
    Departements.nccenr        AS NomDep, 
    Departements.cheflieu       AS cheflieu,
    b.ncc               AS NomVille,
    Regions.ncc            AS NomRegion
    FROM Departements, Regions, Communes a, Communes b
    WHERE a.id_departement = b.id_departement
    AND b.com = TO_NUMBER(SUBSTR(Departements.cheflieu,3))
    AND Regions.id_region = a.id_region
    AND Departements.id_departement = a.id_departement
    AND a.ncc LIKE '%$commune%'
SQL

    # NB ID_DEPARTEMENT en MAJUSCULES, ainsi que tous les $hash_ref_donnee->{$id_dep}{}
  my $hash_ref_donnee = $dbh->selectall_hashref($requete_commune, 'ID_DEPARTEMENT')
      or die "\nERR=dbh->selectall_hashref\n $! \n $@\n$DBI::errstr";
  foreach my $id_dep ( sort { $a <=> $b } keys %{$hash_ref_donnee} ) {
    print "\t - Nom de la commune           : $hash_ref_donnee->{$id_dep}{COMMUNE}\n";
    print "\t - Nom du département           : $hash_ref_donnee->{$id_dep}{NOMDEP}\n";
    print "\t - Ville du chef-lieu dept & code : $hash_ref_donnee->{$id_dep}{NOMVILLE} \t $hash_ref_donnee->{$id_dep}{CHEFLIEU} \n";
    print "\t - Nom de la région           : $hash_ref_donnee->{$id_dep}{NOMREGION}\n\n\n";
  }
  return;
}

#==============================================================
# Pour avoir les accents sur la console DOS ou non
# http://perl.developpez.com/faq/perl/?page=Terminal#Accents
#==============================================================
sub ActiverAccents {
    my $encodage;
    # Windows
      if ( lc($^O ) eq 'mswin32') {
    eval {
        my ($codepage) = ( `chcp` =~ m/:\s+(\d+)/ );
        $encodage = "cp$codepage";
        foreach my $h ( \*STDOUT, \*STDERR, \*STDIN, ) {
        binmode $h, ":encoding($encodage)";
        }
    };    
    }
    else {
    $encodage = `locale charmap`;
    eval {
        foreach my $h ( \*STDOUT, \*STDERR, \*STDIN, ) {
        binmode $h, ":encoding($encodage)";
        }
    };    
    }
  return $encodage;
}

#The following conventions are used in this document:
#
#  $dbh    Database handle object
#  $sth    Statement handle object
#  $drh    Driver handle object (rarely seen or used in applications)
#  $h       Any of the handle types above ($dbh, $sth, or $drh)
#  $rc       General Return Code    (boolean: true=ok, false=error)
#  $rv       General Return Value (typically an integer)
#  @ary    List of values returned from the database, typically a row of data
#  $rows   Number of rows processed (if available, else -1)
#  $fh       A filehandle
#  undef   NULL values are represented by undefined values in Perl
#  \%attr  Reference to a hash of attribute values passed to methods