Как я могу построить семейное дерево с помощью Perl? - PullRequest
Новая
       41

Как я могу построить семейное дерево с помощью Perl?

6 голосов
/ 10 июля 2009

У меня есть программирование на Perl, которое требует от меня сделать следующее:

  1. Создает таблицу в базе данных mySQL и вставляет в нее следующие записи:

  2. Загружает данные из таблицы в массив экземпляров класса Son.

  3. Используя массив, создает HTML-код, представляющий дерево отца-сына, и печатает HTML-код в STDOUT. Нет необходимости, чтобы дерево выглядело хорошо. Примерно так будет хорошо:

tree

У меня заканчиваются идеи, пожалуйста, помогите. Мой код выглядит следующим образом: 

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

Ответы [ 3 ]

5 голосов
/ 10 июля 2009

В ожидании разъяснения относительно вопроса, я подумал, что вы в каком-то учебном заведении получаете задания, связанные с 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
3 голосов
/ 10 июля 2009

Использование GraphViz . Это намного проще, чем сделать фотографию самостоятельно.

1 голос
/ 10 июля 2009

Как бы мне ни нравилось учиться на Ответ Кента Фредрика (видите, я едва написал что-то кроме простых упражнений с использованием 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
...