¿Cómo puedo construir un árbol genealógico con Perl?

Question

que tienen una asignación de programación en Perl que me obliga a hacer lo siguiente:

1. crea una tabla en una base de datos MySQL, e inserta estos registros en él:

2. carga los datos de la tabla en una serie de instancias de la clase Son.

3. Utilizando la matriz, crea código HTML que representa un árbol de padre e hijo, e imprime el código html en la salida estándar. No es necesario hacer que el árbol se vea bien. Algo como esto estaría bien:

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

estoy quedando sin ideas, por favor ayuda. Mi código es el siguiente:

#!/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

A la espera de que se aclare cuál es la pregunta, pensé al ver que estás en algún tipo de institución de educación consiguiendo les asignan tareas relacionadas Perl, pensé que no hay mejor momento para introducir usted a Moose y CPAN, cosas que realmente debería usar en el mundo real.

Es, y sus diversas extensiones, le hará la vida más fácil, y hace que el diseño orientado a objetos más sencillo y fácil de mantener.

#!/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

Por mucho que he disfrutado aprendiendo de Kent Fredric's answer (ver, he nada más allá de simples ejercicios utilizando Moose apenas por escrito), supongo que es posible aprender más por mirar una solución algo más tradicional al problema de mostrar la estructura de datos. No resuelve directamente su pregunta (supongo que su pregunta se basa en una tarea asignada). Si el código demuestra ser útil, estoy seguro de que su instructor apreciaría que cite alguna ayuda externa que haya recibido.

#!/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__ 

Salida:

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

Answer 3

Uso GraphViz. Eso es mucho más fácil que hacer la imagen usted mismo.