Listing 4.
The person script
Lincoln D. Stein

"Web Databases the Genome Project Way"
The Perl Journal, Spring 1999
 
#!/usr/bin/perl
# -*- Mode: perl -*-
# file: person
# Moviedb "person" display

use strict;
use vars '$DB';

use Ace 1.51;
use AceSubs;

use CGI 2.42 qw/:standard :html3 escape/;

# print HTTP header & open the database
AceInit();
$DB = OpenDatabase() || 
   AceError("Couldn't open database.");
AceHeader();

my $person_name = param('name');
my ($person) = $DB->fetch(-class => 'Person',
			   -name => $person_name,
			   -fill => 1
			  ) if $person_name;

print_top($person);
print_warning($person_name) 
          if $person_name && !$person;
print_prompt();
print_report($person)  if $person;
print_bottom();

exit 0;

sub print_top {
  my $person = shift;
  my $title = $person ? "Bio for $person" : 
           'Moviedb Person Report';
  print start_html (
			    '-Title' => $title,
			    '-style' => Style(),
		    ),
       HEADER,
       TypeSelector($person,'Person'),
       h1($title);
}

sub print_bottom { print FOOTER; }

sub print_warning {
  my $name = shift;
  print p(font({-color => 'red'},
    "The person named \"$name\" 
	   is not found in the database."));
}

sub print_prompt {
  print
    start_form({-name=>'form1',
	         -action=>Url(url(-relative=>1))}),
    p("Database ID",
      textfield(-name=>'name')
    ),
    end_form;
}

sub print_report {
  my $person = shift;

  print h2($person->Full_name);

  if (my @address = $person->Address(2)) {
    print h3('Contact Information'),
		        blockquote(address(join(br,@address)));
    print a({-href=>'mailto:' . $person->Email(1)},
	"Send e-mail to this person") 
	            if $person->Email;
  } else {
    print p(font({-color=>'red'},
		 'No contact information in database'));
  }

  if ($person->Born || 
      $person->Height) {
    print h3('Fun Facts'),
	  table({-border=>undef},
		TR({-align=>'LEFT'}, th('Height'),
			 td($person->Height(1) || '?')),
		TR({-align=>'LEFT'}, th('Birthdate'),
			 td($person->Born(1) || '?'))
	       ),
  }

  if (my @directed = $person->Directed) {
      print h3('Movies Directed');
      my @full_names = map 
	              { a({-href=>Object2URL($_)},
			      $_->Title) } @directed;
      print ol(li \@full_names);
  }

  if (my @scripted = $person->Scripted) {
      print h3('Movies Scripted');
      my @full_names = map { a({-href=>Object2URL($_)},
			      $_->Title) } @scripted;
      print ol(li \@full_names);
  }

  if (my @stars_in = $person->Stars_in) {
      print h3('Starring Roles In');
      my @full_names = map { a({-href=>Object2URL($_)},
			      $_->Title) } @stars_in;
    print ol(li \@full_names);
  }
}