Question

我在Perl中有一个编程任务，要求我执行以下操作：

在mySQL数据库中创建一个表，并将这些记录插入其中：
将表中的数据加载到Son类的实例数组中。
使用数组创建表示父子树的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

如何用Perl构建一个家谱？

3 个答案: