如何使用Perl构建家谱树？

Question

我有一个Perl编程作业，需要我完成以下任务：

1. 在mySQL数据库中创建表，并将这些记录插入其中：

2. 从表中加载数据到Son类的实例数组中。

3. 使用该数组创建代表父子树的HTML代码，并将html代码打印到STDOUT。不必让树看起来很好。像下面这样就可以：

我已经没有更多的想法了，请帮帮我。 我的代码如下：

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

- Troy C.

---

"Running out of ideas"的意思是 "想法用尽"，具体指什么样的想法并没有提出问题，只是说明了你需要完成任务但不知道如何处理。 - Kent Fredric

你的问题实际上并不涉及CGI或MySQL。它关乎于选择和展示一个合适的数据结构。你的代码包含了太多与手头任务无关的细节。 - Sinan Ünür

只是想知道我是完全偏离了还是走在正确的轨道上。抱歉/谢谢。 - Troy C.

请将您完成的代码发布为答案。 - Brad Gilbert

Answer 1

在等待澄清问题之际，我想你正在某种学习机构中接受与Perl相关的任务，我认为现在介绍Moose和CPAN是最好的时机，这些东西在现实世界中确实应该使用。

Moose及其各种扩展将使您的生活更加轻松，使面向对象设计更加直观和可维护。

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

- Kent Fredric

---

我只是想知道是否有人对如何更好地完成手头的任务有任何建议。我不是在寻求帮助。谢谢你们关于 Moose 和 CPAN 的教学！虽然我是 Perl 的新手，但了解最佳实践方法非常有帮助。再次感谢。 - Troy C.

Answer 2

使用GraphViz，这比自己制作图片要容易得多。

- brian d foy

Answer 3

尽管我很喜欢从Kent Fredric的答案中学习（但是，除了使用Moose进行简单的练习之外，我几乎没有写过什么），但我认为你可能会通过查看一个更传统的解决方案来展示数据结构而学到更多。 它并没有直接解决你的问题（我假设你的问题是基于一项家庭作业）。如果这段代码被证明有用，我相信你的讲师会感激你引用任何外部帮助。

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

输出：

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

- Sinan Ünür

---

这似乎是对于像我这样刚学习 Perl 的人来说最易理解的。虽然昨晚我设法拼凑出了一个解决我的问题的答案，但这也是一个更简单的解决方案。谢谢！我会从这个例子中学到东西的！ - Troy C.