How can I construct a family tree with Perl?

Question

I have a programming assignment in Perl that requires me to do the following:

1. Creates a table in a mySQL database, and inserts these records into it:

2. Loads the data from the table into an array of instances of class Son.

3. Using the array, creates HTML code representing a father-son tree, and prints the html code to STDOUT. It's not necessary to make the tree look good. Something like this would be fine:

I'm running out of ideas, please help. My code is as follows:

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

While awaiting clarification as to what the question is, I figured seeing you're in some sort of learning institution getting given Perl related assignments, I reasoned there's no better time to introduce you to Moose and CPAN, things you really should be using in the real world.

It, and its various extensions, will make your life easier, and makes Object Oriented design more straight forward and maintainable.

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