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