OVH Cloud OVH Cloud

générer un tableau tridimensionnel avec une subroutine récursive

1 réponse
Avatar
Philippe
Bonjour,

J'essaye de générer un tableau à trois dimension avec une subroutine
récursive : j'y suis presque, mais je n'arrive pas à obtenir exactement
ce qu'il faut :(

le but est de lister l'arborescence de catégories d'instruments de
musique avec leur caractéristiques et les samples qui leur sont associés.

voilà ce que j'obtient pour l'instant :

$VAR1 = [
0,
{
'samples' => [],
'visible' => 0,
'category_id' => 'a1e6b803d8708ab0bcfc7cbdd3e36bad',
'level' => 1,
'category_name' => 'Guitar'
},
1,
{
'samples' => [
'438648d7900e7',
'43a8b69c31832',
'43a8b68600902'
],
'visible' => 1,
'category_id' => '40875778b54b954cf67cf68cf546cebf',
'level' => 1,
'category_name' => 'Acoustic guitar'
},
1,
{
'samples' => [],
'visible' => 0,
'category_id' => '227101c65333076ba1f7b19ae9fc95e1',
'level' => 1,
'category_name' => 'Distortion guitar'
},
{
'samples' => [],
'visible' => 0,
'category_id' => 'e8c13aff2e5af12457a275b412b96759',
'level' => 1,
'category_name' => 'Piano'
},
1,
{
'samples' => [
'43a8b62d50cdc',
'43a8b6057f0c6',
'43a8b5e3d461b',
'437172a08168e'
],
'visible' => 1,
'category_id' => '20d9f77a7cd34222b76b10841a685927',
'level' => 1,
'category_name' => 'Acoustic piano'
},
1,
{
'samples' => [],
'visible' => 0,
'category_id' => 'a04e6370c38244f77df434da819cbadc',
'level' => 1,
'category_name' => 'Clavecin'
},
1
]

voilà ce que je voudrais :

$VAR1 = [
{
'samples' => [],
'visible' => 0,
'category_id' => 'a1e6b803d8708ab0bcfc7cbdd3e36bad',
'level' => 1,
'category_name' => 'Guitar'
},
{
'samples' => [
'438648d7900e7',
'43a8b69c31832',
'43a8b68600902'
],
'visible' => 1,
'category_id' => '40875778b54b954cf67cf68cf546cebf',
'level' => 2,
'category_name' => 'Acoustic guitar'
},
{
'samples' => [],
'visible' => 0,
'category_id' => '227101c65333076ba1f7b19ae9fc95e1',
'level' => 2,
'category_name' => 'Distortion guitar'
},
{
'samples' => [],
'visible' => 0,
'category_id' => 'e8c13aff2e5af12457a275b412b96759',
'level' => 1,
'category_name' => 'Piano'
},
{
'samples' => [
'43a8b62d50cdc',
'43a8b6057f0c6',
'43a8b5e3d461b',
'437172a08168e'
],
'visible' => 1,
'category_id' => '20d9f77a7cd34222b76b10841a685927',
'level' => 2,
'category_name' => 'Acoustic piano'
},
{
'samples' => [],
'visible' => 0,
'category_id' => 'a04e6370c38244f77df434da819cbadc',
'level' => 2,
'category_name' => 'Clavecin'
}
]


donc lorsqu'il y a des samples dans la catégorie, le hash "visible" est
bien égal à 1 sinon il est égal à 0.
mais $level n'est pas incrémenté; par exemple pour "Acoustic piano" qui
est une sous-catégorie de "piano", $level devrait être égal à 2
de plus $level s'intercale à chaque fois entre les hash.

voici le script qui génère la mauvaise structure de données :

#!/usr/bin/perl

use warnings;
use strict;
use DBI;
use Data::Dumper;

print "Content-type: text/ascii\n\n";

my $dbh = DBI->connect('dbi:mysql:my_db','user','passwd') || die
"$DBI::errstr\n";

sub fill_cat_array
{

my ($dbh,$parent,@cat_array,$level) = @_;

$level++;

my $q1 = "SELECT category_id,category_name ";
$q1.= "FROM category,category_xref ";
$q1.= "WHERE category_id = category_child_id ";
$q1.= "AND category_parent_id = ? ";
$q1.= "ORDER BY category_name ASC ";

my $sth1 = $dbh->prepare($q1) || die "$DBI::errstr\n";

my $q2 = "SELECT product_id FROM sampler,product ";
$q2.= "WHERE sampler.user_id = ? ";
$q2.= "AND product_id = product_ref ";
$q2.= "AND product_parent_id = ? ";
$q2.= "ORDER BY sample_name ASC ";

my $sth2 = $dbh->prepare_cached($q2) || die "$DBI::errstr\n";

$sth1->execute($parent) || die "$DBI::errstr\n";

while (my $category = $sth1->fetchrow_hashref)
{

$sth2->execute($category->{category_id}) || die "$DBI::errstr\n";

my $visible;

my @samples_ref = ();

if ($sth2->rows > 0)
{

$visible = 1;

while (my $sample = $sth2->fetchrow_hashref)
{

push @samples_ref,$sample->{product_id};

}
}
else
{

$visible = 0;

}

$sth2->finish() || die "$DBI::errstr\n";

my $list = {
'level' => $level,
'category_id' => $category->{category_id},
'category_name' => $category->{category_name},
'visible' => $visible,
'samples' => \@samples_ref
};

push @cat_array,$list;

@cat_array =
fill_cat_array($dbh,$category->{category_id},@cat_array,$level);

}

$sth1->finish() || die "$DBI::errstr\n";

return @cat_array;
}

my @big_array = ();
@big_array = fill_cat_array($dbh,0,@big_array,0);

print Dumper(\@big_array);

$dbh->disconnect() || die "$DBI::errstr\n";

exit 0;

je ne vois pas du tout comment obtenir le bon résultat.
si quelqu'un pouvait me pointer mon erreur, ce serait sympa.

cordialement

***
Philippe

1 réponse

Avatar
Philippe
J'ai certainement dû mal exposer mon problème, mais je ne vois pas comment
faire mieux.
peut-être que perl ne prévoit pas ce genre de problématique...je n'y crois
pas un seul instant
svp juste un petit coup de pouce vers la bonne direction.

Merci d'avance

***
Philippe

"Philippe" a écrit dans le message de
news:453bd709$0$31666$
Bonjour,

J'essaye de générer un tableau à trois dimension avec une subroutine
récursive : j'y suis presque, mais je n'arrive pas à obtenir exactement
ce qu'il faut :(

le but est de lister l'arborescence de catégories d'instruments de
musique avec leur caractéristiques et les samples qui leur sont associés.

voilà ce que j'obtient pour l'instant :

$VAR1 = [
0,
{
'samples' => [],
'visible' => 0,
'category_id' => 'a1e6b803d8708ab0bcfc7cbdd3e36bad',
'level' => 1,
'category_name' => 'Guitar'
},
1,
{
'samples' => [
'438648d7900e7',
'43a8b69c31832',
'43a8b68600902'
],
'visible' => 1,
'category_id' => '40875778b54b954cf67cf68cf546cebf',
'level' => 1,
'category_name' => 'Acoustic guitar'
},
1,
{
'samples' => [],
'visible' => 0,
'category_id' => '227101c65333076ba1f7b19ae9fc95e1',
'level' => 1,
'category_name' => 'Distortion guitar'
},
{
'samples' => [],
'visible' => 0,
'category_id' => 'e8c13aff2e5af12457a275b412b96759',
'level' => 1,
'category_name' => 'Piano'
},
1,
{
'samples' => [
'43a8b62d50cdc',
'43a8b6057f0c6',
'43a8b5e3d461b',
'437172a08168e'
],
'visible' => 1,
'category_id' => '20d9f77a7cd34222b76b10841a685927',
'level' => 1,
'category_name' => 'Acoustic piano'
},
1,
{
'samples' => [],
'visible' => 0,
'category_id' => 'a04e6370c38244f77df434da819cbadc',
'level' => 1,
'category_name' => 'Clavecin'
},
1
]

voilà ce que je voudrais :

$VAR1 = [
{
'samples' => [],
'visible' => 0,
'category_id' => 'a1e6b803d8708ab0bcfc7cbdd3e36bad',
'level' => 1,
'category_name' => 'Guitar'
},
{
'samples' => [
'438648d7900e7',
'43a8b69c31832',
'43a8b68600902'
],
'visible' => 1,
'category_id' => '40875778b54b954cf67cf68cf546cebf',
'level' => 2,
'category_name' => 'Acoustic guitar'
},
{
'samples' => [],
'visible' => 0,
'category_id' => '227101c65333076ba1f7b19ae9fc95e1',
'level' => 2,
'category_name' => 'Distortion guitar'
},
{
'samples' => [],
'visible' => 0,
'category_id' => 'e8c13aff2e5af12457a275b412b96759',
'level' => 1,
'category_name' => 'Piano'
},
{
'samples' => [
'43a8b62d50cdc',
'43a8b6057f0c6',
'43a8b5e3d461b',
'437172a08168e'
],
'visible' => 1,
'category_id' => '20d9f77a7cd34222b76b10841a685927',
'level' => 2,
'category_name' => 'Acoustic piano'
},
{
'samples' => [],
'visible' => 0,
'category_id' => 'a04e6370c38244f77df434da819cbadc',
'level' => 2,
'category_name' => 'Clavecin'
}
]


donc lorsqu'il y a des samples dans la catégorie, le hash "visible" est
bien égal à 1 sinon il est égal à 0.
mais $level n'est pas incrémenté; par exemple pour "Acoustic piano" qui
est une sous-catégorie de "piano", $level devrait être égal à 2
de plus $level s'intercale à chaque fois entre les hash.

voici le script qui génère la mauvaise structure de données :

#!/usr/bin/perl

use warnings;
use strict;
use DBI;
use Data::Dumper;

print "Content-type: text/asciinn";

my $dbh = DBI->connect('dbi:mysql:my_db','user','passwd') || die
"$DBI::errstrn";

sub fill_cat_array
{

my ($dbh,$parent,@cat_array,$level) = @_;

$level++;

my $q1 = "SELECT category_id,category_name ";
$q1.= "FROM category,category_xref ";
$q1.= "WHERE category_id = category_child_id ";
$q1.= "AND category_parent_id = ? ";
$q1.= "ORDER BY category_name ASC ";

my $sth1 = $dbh->prepare($q1) || die "$DBI::errstrn";

my $q2 = "SELECT product_id FROM sampler,product ";
$q2.= "WHERE sampler.user_id = ? ";
$q2.= "AND product_id = product_ref ";
$q2.= "AND product_parent_id = ? ";
$q2.= "ORDER BY sample_name ASC ";

my $sth2 = $dbh->prepare_cached($q2) || die "$DBI::errstrn";

$sth1->execute($parent) || die "$DBI::errstrn";

while (my $category = $sth1->fetchrow_hashref)
{

$sth2->execute($category->{category_id}) || die "$DBI::errstrn";

my $visible;

my @samples_ref = ();

if ($sth2->rows > 0)
{

$visible = 1;

while (my $sample = $sth2->fetchrow_hashref)
{

push @samples_ref,$sample->{product_id};

}
}
else
{

$visible = 0;

}

$sth2->finish() || die "$DBI::errstrn";

my $list = {
'level' => $level,
'category_id' => $category->{category_id},
'category_name' => $category->{category_name},
'visible' => $visible,
'samples' => @samples_ref
};

push @cat_array,$list;

@cat_array > fill_cat_array($dbh,$category->{category_id},@cat_array,$level);

}

$sth1->finish() || die "$DBI::errstrn";

return @cat_array;
}

my @big_array = ();
@big_array = fill_cat_array($dbh,0,@big_array,0);

print Dumper(@big_array);

$dbh->disconnect() || die "$DBI::errstrn";

exit 0;

je ne vois pas du tout comment obtenir le bon résultat.
si quelqu'un pouvait me pointer mon erreur, ce serait sympa.

cordialement

***
Philippe