Comment puis-je construire un arbre généalogique avec Perl?

Question

J'ai une mission de programmation en Perl qui me demande de faire ce qui suit:

1. Crée une table dans une base de données mySQL et insère ces enregistrements dans le:

2. charge les données de la table dans un tableau d'instances de la classe Son.

3. Utilisation du tableau, crée le code HTML représentant un arbre père-fils, et imprime le code html à STDOUT. Il n'est pas nécessaire de rendre l'arbre beau. Quelque chose comme ça serait bien:

tree http://i25.tinypic.com/314t177.png

Je suis à court d'idées, s'il vous plaît aider. Mon code est le suivant:

#!/usr/bin/perl 

use strict; 
use Son; 
use CGI; 
use Data::Dumper; 
use DBI; 
my $q = new CGI; 

#DB connect vars 
my $user = "##"; 
my $pass = "##"; 
my $db = "##"; 
my $host = "localhost"; 

my $dsn = "DBI:mysql:database=$db;host=$host"; 

my $dbh = DBI->connect($dsn,$user,$pass); 
eval { $dbh->do("DROP TABLE sons") }; 
print "Drop failed: $@\n" if $@; 

$dbh->do("CREATE TABLE sons (son VARCHAR(30) PRIMARY KEY, father VARCHAR(30))"); 

my @rows = (["bill", "sam"], 
     ["bob", ""], 
     ["jack", "sam"], 
     ["jone", "mike"], 
     ["mike", "bob"], 
     ["sam", "bob"] 
); 

for my $i (0 .. $#rows) { 
    $dbh->do("INSERT INTO sons (son, father) VALUES (?,?)", {}, $rows[$i][0], $rows[$i][1]); 
} 

our @sons_array; 
my $sth = $dbh->prepare("SELECT * FROM sons"); 
$sth->execute(); 
while (my $ref = $sth->fetchrow_hashref()) { 
    $sons_array[++$#sons_array] = Son->new($ref->{'son'}, $ref->{'father'}); 
} 
$sth->finish(); 
$dbh->disconnect(); 


print $q->header("text/html"),$q->start_html("Perl CGI"); 
print "\n\n"; 
constructFamilyTree(@sons_array, ''); 
print $q->end_html; 

sub constructFamilyTree { 
    my @sons_array = @_[0..$#_ -1]; 
    my $print_father; 
    my $print_son; 
    my $print_relation; 
    my $current_parent = @_[$#_]; 
    my @new_sons_array; 
    my @new_siblings; 

    #print $current_parent."\n"; 
    foreach my $item (@sons_array){ 
     if(!$item->{'son'} || $item->{'son'} eq $item->{'father'}) { # == ($item->{'son'} eq '') 
      print "\n List contains bad data\n"; 
      return 0; 
     } 

     if($item->{'father'} eq $current_parent) { 
      my $temp_print_relation; 
      foreach my $child (@sons_array) { 
       if($child->{'father'} eq $item->{'son'}) { 
        if(!$temp_print_relation) { 
         $temp_print_relation .= ' |'; 
        } 
        else { 
         $temp_print_relation .= '-----|'; 
        } 
       } 
      } 
      $print_relation .= $temp_print_relation." "; 
      $print_son .= '('.$item->{'son'}.') '; 
      @new_siblings[++$#new_siblings] = $item; 
      $print_father = $item->{'father'}; 
     } 
     else { 
      $new_sons_array[++$#new_sons_array] = $item; 
     } 
    } 

    print $print_son. "\n". $print_relation."\n"; 
    #print $print_father."\n"; 
    #print $print_relation . "\n". $print_son; 
    foreach my $item (@new_siblings) { 
     constructFamilyTree(@new_sons_array, $item->{'son'}); 
    } 
} 


perl module: 
#File Son.pm, module for class Son 

package Son; 

sub new { 
    my($class, $son, $father) = @_; 
    my $self = {'son' => $son, 
       'father' => $father}; 

    bless $self, $class; 
    return $self; 
} 

1; 

Answer 1

En attendant des éclaircissements quant à ce que la question est, je me suis dit en voyant que vous êtes dans une sorte d'institution d'apprentissage se donné des missions liées Perl, je raisonnais il n'y a pas de meilleur moment pour présenter à Moose et CPAN, des choses que vous devriez vraiment utiliser dans le monde réel.

, et ses diverses extensions, vous rendra la vie plus facile, et rend la conception orientée objet plus direct et maintenable.

#!/usr/bin/perl 
use strict; 
use warnings; 
use Data::Dumper; 
use Moose::Autobox; 
use 5.010; 

sub Moose::Autobox::SCALAR::sprintf { 
    my $self = shift; 
    sprintf($self, @_); 
} 

{ 

    package Son; 
    use Moose; 
    use MooseX::Types::Moose qw(:all); 
    use MooseX::ClassAttribute; 
    use MooseX::Has::Sugar 0.0300; 
    use Moose::Autobox; 

    class_has 'Ancestry' => (isa => HashRef, rw, default => sub { {} }); 
    class_has 'People' => (isa => HashRef, rw, default => sub { {} }); 
    has 'name'   => (isa => Str,  rw, required); 
    has 'father'   => (isa => Str,  rw, required); 

    sub BUILD { 
    my $self = shift; 
    $self->Ancestry->{ $self->name } //= {}; 
    $self->Ancestry->{ $self->father } //= {}; 
    $self->People->{ $self->name }  //= $self; 
    $self->Ancestry->{ $self->father }->{ $self->name } = $self->Ancestry->{ $self->name }; 
    } 

    sub children { 
    my $self = shift; 
    $self->subtree->keys; 
    } 

    sub subtree { 
    my $self = shift; 
    $self->Ancestry->{ $self->name }; 
    } 

    sub find_person { 
    my ($self, $name) = @_; 
    return $self->People->{$name}; 
    } 

    sub visualise { 
    my $self = shift; 
    '<ul><li class="person">%s</li></ul>'->sprintf($self->visualise_t); 
    } 

    sub visualise_t { 
    my $self = shift; 
    '%s <ul>%s</ul>'->sprintf(
     $self->name, 
     $self->children->map(
     sub { 
      '<li class="person">%s</li>'->sprintf($self->find_person($_)->visualise_t); 
     } 
     )->join('') 
    ); 
    } 
    __PACKAGE__->meta->make_immutable; 
} 

my @rows = ([ "bill", "sam" ], [ "bob", "" ], [ "jack", "sam" ], [ "jone", "mike" ], [ "mike", "bob" ], [ "sam", "bob" ],); 

for (@rows) { 
    Son->new(
    father => $_->at(1), 
    name => $_->at(0), 
); 
} 

<<'EOX'->sprintf(Son->find_person('bob')->visualise)->say; 
<html> 
    <head> 
    <style> 
     li.person { 
border: 1px solid #000; 
padding: 4px; 
margin: 3px; 
background-color: rgba(0,0,0,0.05); 
     } 
    </style> 
    </head> 
    <body> 
    %s 
    </body> 
</html> 
EOX 

Answer 2

Autant que j'ai aimé apprendre de Kent Fredric's answer (voir, j'ai quelque chose à peine écrit au-delà des exercices simples à l'aide Moose), je figure que vous pourriez en apprendre davantage en regardant une solution un peu plus traditionnelle au problème de l'affichage de la Structure de données. Il ne résoudra pas directement votre question (Je suppose que votre requête est basée sur un devoir). Si le code s'avère utile, je suis sûr que votre instructeur apprécierait que vous mentionniez toute aide extérieure que vous avez reçue.

#!/usr/bin/perl 

use strict; 
use warnings; 

my @rows = (
    [ bill => 'sam' ], 
    [ bob => ''  ], 
    [ jack => 'sam' ], 
    [ jone => 'mike' ], 
    [ mike => 'bob' ], 
    [ sam => 'bob' ], 
    [ jim => ''  ], 
    [ ali => 'jim' ], 
); 

my %father_son; 

for my $pair (@rows) { 
    push @{ $father_son{ $pair->[1] } }, $pair->[0]; 
} 

for my $root (@{ $father_son{''} }) { 
    print_branch($root, 0); 
} 

sub print_branch { 
    my ($branch, $level) = @_; 
    print "\t" x $level, $branch, "\n"; 
    if (exists $father_son{$branch}) { 
     for my $next_branch (@{ $father_son{$branch} }) { 
      print_branch($next_branch, $level + 1); 
     } 
    } 
    return; 
} 

__END__ 

sortie:

C:\Temp> tkl 
bob 
     mike 
       jone 
     sam 
       bill 
       jack 
jim 
     ali 

Answer 3

utilisation GraphViz. C'est beaucoup plus facile que de faire l'image vous-même.