Se connecter à la base de donnée Sqlite3 « labintel.sqlite3 »
1: use Data::Dumper ; 2: use DBI; 3: use strict ; 4: 5: # Les 2 lignes suivantes ne servent qu'à vérifier 6: # que les drivers SQLite sont là 7: 8: my @drivers = DBI->available_drivers() ; 9: print Dumper \@drivers ; # le résultat est plus joli avec une référence 10: 11: my $ds = 'DBI:SQLite:labintel.sqlite3' ; # data source 12: my $dbh = DBI->connect($ds) ; # database handler 13: 14: $dbh->disconnect() ;
1: $dbh->do(<<"EOT"); 2: CREATE TABLE pers 3: ( 4: id integer, 5: p_numero_sel varchar(50), 6: name varchar(50), 7: PRIMARY KEY (id) 8: ) 9: EOT 10: 11: $dbh->do(<<"EOT"); 12: CREATE TABLE pers_attr 13: ( 14: id integer, 15: pers_id varchar(50), 16: attribute varchar(50), 17: value varchar(50), 18: PRIMARY KEY (id) 19: ) 20: EOT
Remarque : le heredoc permet de formuler les requêtes SQL dans un format habituel
Peupler la table « pers » à partir du fichier « pers.yaml ».
--- - id: 1 p_numero_sel: '1234567890' name: 'davinci' - id: 2 p_numero_sel: '3456789012' name: 'watson'
1: use IO::YAML; 2: 3: my ($sth) ; 4: my $io = IO::YAML->new("pers.yaml"); 5: while (<$io>) 6: { 7: my $data = YAML::Load($_); 8: unless (defined($sth)) 9: { 10: # faire seulement au premier tour 11: 12: my $data0 = $data->[0] ; 13: my $sql = sprintf("insert into %s (%s) values (%s)" 14: , "pers" 15: , join(",", keys %$data0) # ce qui donne : id,pers_id,attribute,value 16: , join(",", ("?")x values(%$data0)) # ce qui donne : ?,?,?,? 17: ) ; 18: $sth = $dbh->prepare($sql); 19: } 20: 21: for my $d (@$data) 22: { 23: $sth->execute(values %$d) ; 24: } 25: $sth->finish() ; 26: } 27: $dbh->disconnect() ;
Remarque :
x
appliqué à une chaîne la démuliplie. Exemple “Z”x5
donne “ZZZZZ”
Peupler la table « pers_attr » à partir du fichier « pers_attr.json ».
[{ "id": 1, "pers_id": 1, "attribute": "email", "value": "leonardo@vinci-closluce.com" },{ "id": 2, "pers_id": 1, "attribute": "labo", "value": "umrxyz" }]
1: use JSON; 2: use DBI; 3: 4: open(F,"pers_attr.json") or die ; 5: my @s = <F> ; 6: close(F) ; 7: 8: chomp(@s) ; 9: my $s = join(" ",@s) ; 10: 11: my $json = new JSON ; 12: my $data = $json->decode($s) ; 13: 14: my ($sth) ; 15: 16: my $data0 = $data->[0] ; 17: my $sql = sprintf("insert into %s (%s) values (%s)" 18: , "pers_attr" 19: , join(",", keys %$data0) # ce qui donne : id,pers_id,attribute,value 20: , join(",", ("?")x values(%$data0)) # ce qui donne : ?,?,?,? 21: ) ; 22: $sth = $dbh->prepare($sql); 23: 24: for my $d (@$data) 25: { 26: $sth->execute(values %$d) ; 27: } 28: $sth->finish() ; 29: $dbh->disconnect() ;
Lister toutes les entrées de la table pers et de la table pers_attrs
1: #!/usr/bin/perl 2: 3: use DBI; 4: use File::Basename ; 5: use strict ; 6: 7: sub usage 8: { 9: printf(<<"EOT",basename($0)) ; 10: usage: %s table_name 11: EOT 12: exit(1) ; 13: } 14: 15: my $table = shift() or usage() ; 16: 17: my $ds = 'DBI:SQLite:labintel.sqlite3' ; 18: my $dbh = DBI->connect($ds) ; 19: my $sth = $dbh->prepare(sprintf(<<"EOT",$table)) or exit(1) ; 20: select * from %s ; 21: EOT 22: 23: $sth->execute() or die "$!\n" ; 24: 25: while (my @data = $sth->fetchrow_array()) 26: { 27: printf("%s\n",join(" ",@data)) ; 28: } 29: 30: $sth->finish() ; 31: $dbh->disconnect() ;
Note : ce programme liste le contenu d'une table dont le nom est passé en argument sur la ligne de commande. Il répond donc aux 2 questions
pour chaque entrée de la table « pers » lister toutes les entrées associées de la table « pers_attr » (jointure)
1: my $sth = $dbh->prepare(<<"EOT") ; 2: SELECT pers.id,name,pers_id,attribute,':',value 3: FROM pers,pers_attr 4: WHERE pers.id=pers_id 5: ; 6: EOT
ajouter un attribut « statut=chercheur » à la personne ayant l'id 1
1: my $sth = $dbh->prepare(<<"EOT") ; 2: INSERT INTO pers_attr 3: (pers_id,attribute,value) 4: VALUES (1,'statut','chercheur') 5: EOT
ajouter une contrainte d'unicité sur l'attribut « statut »
lister toutes les personnes ayant le statut de chercheurs
1: my $sth = $dbh->prepare(<<"EOT") ; 2: SELECT pers.id,name 3: FROM pers,pers_attr 4: WHERE pers.id=pers_id AND value = "chercheur" 5: ; 6: EOT