如何用 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;

Answer 1

在等待澄清问题是什么时，我想看到您在某种学习机构中获得与 Perl 相关的作业，我认为现在是向您介绍 Moose 和 CPAN 的最佳时机，您真正应该做的事情在现实世界中使用。

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

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

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

Answer 3

尽管我很喜欢从 Kent Fredric's answer 学习（请参阅，除了使用 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