File Coverage

lib/Myco/Core/Person.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Myco::Core::Person;

###############################################################################
# $Id: Person.pm,v 1.1.1.1 2006/02/28 22:15:51 sommerb Exp $
#
# See license and copyright near the end of this file.
###############################################################################

=head1 NAME

Myco::Core::Person - Myco Person objects.

=item Release

1.0

=cut

our $VERSION = 1.0;

=head1 SYNOPSIS

  use Myco;

  # Constructors. See Myco::Entity for more.
  my $p = Myco::Core::Person->new;

  # Name.
  my $last = $p->get_last;
  $p = $p->set_last($last);
  my $first = $p->get_first;
  $p = $p->set_first($first);
  my $middle = $p->get_middle;
  $p = $p->set_middle($middle);
  my $prefix = $p->get_prefix;
  $p = $p->set_prefix($prefix);
  my $suffix = $p->get_suffix;
  $p = $p->set_suffix($suffix);
  my $nick = $p->get_nick;
  $p = $p->set_nick($nick);

  # Vital Stats.
  my $gender = $p->get_gender;
  $p = $p->set_gender($gender);
  my $birthdate = $p->get_birthdate;
  $p = $p->set_birthdate($birthdate);

  # Added instance methods.
  my $format = "%p% f% M% l%, s";
  my $name = $p->strfname($format);
  my $uidf = $p->get_unique_id_fmt;

  # Persistence methods.
  $p->save;
  $p->destroy;

=head1 DESCRIPTION

This class represents what may well be the central object of any Myco-based
application: the Person. Myco::Core::Person provides the absolute bare bones
skeleton of what most applications will need in a person object.

=cut

##############################################################################
# Dependencies
##############################################################################
# Module Dependencies and Compiler Pragma
use warnings;
use strict;
use Myco::Exceptions;

##############################################################################
# Programmatic Dependencies
use Lingua::Strfname ();
use Myco::Util::Strings;

##############################################################################
# Inheritance & Introspection
##############################################################################
use lib '/usr/home/sommerb/dev/myco/lib';
use base qw(Myco::Entity);
my $md = Myco::Entity::Meta->new
  ( name => __PACKAGE__,
    tangram => { table => 'myco_core_person' },
  );

##############################################################################
# Function and Closure Prototypes
##############################################################################

# Use this code reference to validate the Unique ID.
my $chk_uid = sub {
    Myco::Exception::DataValidation->throw
      (error => "id must be of form ####-####-# (dashes optional)")
      unless defined ${$_[0]} and ${$_[0]} =~ /^\d{9}$/;
};

##############################################################################
# Queries - this is delayed to avoid compile loops
##############################################################################
my $queries = sub {
    my $md = shift;

    $md->add_query( name => 'default',
                    remotes => { '$p_' => 'Myco::Core::Person', },
                    result_remote => '$p_',
                    params => { last => [ qw($p_ last) ], },
                    filter => {
                               parts => [ { remote => '$p_',
                                            attr => 'last',
                                            oper => 'eq',
                                            param => 'last' },
                                        ] },
                  );

};

##############################################################################
# Constructor, etc.
##############################################################################

=head1 COMMON ENTITY INTERFACE

Constructor, accessors, and other methods -- as inherited from Myco::Entity.

=cut

##############################################################################
# Attributes & Attribute Accessors / Schema Definition
##############################################################################

=head1 ATTRIBUTES

Attributes may be initially set during object construction (with C) but
otherwise should be accessed solely through accessor methods. Typical usage:

=over 3

=item *

Set attribute value

 $p->set_attribute($value);

Check functions (see L) perform data
validation. If there is any concern that the set method might be called with
invalid data then the call should be wrapped in an C block to catch
exceptions that would result.

=item *

Get attribute value

 $value = $p->get_attribute;

=back

A listing of available attributes follows:

=cut

=head2 last

 type: string(64)  required: not empty

The personE<39>s last name.

=cut

$md->add_attribute( name => 'last',
                    type => 'string',
                    type_options => { string_length => 64 },
                    synopsis => 'Last Name',
                    tangram_options => { required => 1 },
                  );


=head2 first

 type: string(64)

The personE<39>s first name.

=cut

$md->add_attribute(name => 'first',
                   type => 'string',
		   type_options => { string_length => 64 },
                   synopsis => 'First Name',
                  );


=head2 middle

 type: string(64)

The personE<39>s middle name.

=cut

$md->add_attribute(name => 'middle',
                   type => 'string',
		   type_options => { string_length => 64 },
                   synopsis => 'Middle Name',
                  );

=head2 prefix

 type: string(32)

The prefix to the personE<39>s name.

=cut

$md->add_attribute(name => 'prefix',
                   type => 'string',
		   type_options => { string_length => 32 },
                   synopsis => 'Prefix',
		   values => [ qw( __select__ Ms. Miss Mrs. Mr. __other__ )],
                  );

=head2 suffix

 type: string(32)

The suffix to the personE<39>s name.

=cut

$md->add_attribute(name => 'suffix',
                   type => 'string',
		   type_options => { string_length => 32 },
                   synopsis => 'Suffix',
		   values => [ qw( __select__ Jr. Sr. M.D. PhD. __other__ )],
                  );

=head2 nick

 type: string(64)

The personE<39>s nick name.

=cut

$md->add_attribute(name => 'nick',
                   type => 'string',
		   type_options => { string_length => 64 },
                   synopsis => 'Nick Name',
                  );

=head2 birthdate

 type: rawdate

The personE<39>s birthday.

=cut

$md->add_attribute( name => 'birthdate',
		    syntax_msg => 'YYYY-MM-DD (dashes optional)',
                    type => 'rawdate',
                    ui => { label => 'Birth Date' },
                  );


##############################################################################
# Methods
##############################################################################

=head1 ADDED CLASS / INSTANCE METHODS

=head2 strfname

  my $format = "%p% f% M% l%, s";
  my $name = $person->strfname($format);

This method allows the parts of the personE<39>s name to be formatted according
to the strfname formatting template syntax. See
L for the details of the formatting
syntax. Note that the only difference here is that the "first extra name" is
always the personE<39>s nick name. Thus, the formatting characters are as
follows:

  %l Last Name
  %f First Name
  %m Middle Name
  %p Prefix
  %s Suffix
  %a Nick Name
  %L Last Name Initial with period
  %F First Name Initial with period
  %M Middle Name Initial with period
  %A Nick Name Initial with period
  %T Last Name Initial
  %S First Name Initial
  %I Middle Name Initial
  %1 Nick Name Initial

=cut

sub strfname {
    Lingua::Strfname::strfname($_[1],
      @{$_[0]}{qw(last first middle prefix suffix nick)})
}

##############################################################################
# Object Schema Activation and Metadata Finalization
##############################################################################
$md->activate_class( queries => $queries );

1;
__END__