Bio::Phylo::Project - Container for related data

 use Bio::Phylo::Factory;
 my $fac  = Bio::Phylo::Factory->new;
 my $proj = $fac->create_project;
 my $taxa = $fac->create_taxa;
 $proj->insert($taxa);
 $proj->insert($fac->create_matrix->set_taxa($taxa));
 $proj->insert($fac->create_forest->set_taxa($taxa));
 print $proj->to_xml;

 $Id: Project.pm 1660 2011-04-02 18:29:40Z rvos $

package Bio::Phylo::Project;
use strict;
use base 'Bio::Phylo::Listable';
use Bio::Phylo::Util::CONSTANT qw':all';
use Bio::Phylo::Util::Exceptions 'throw';
use Bio::Phylo::Util::Logger;
use Bio::Phylo::IO 'parse';
use Bio::Phylo::Factory;
my $fac    = Bio::Phylo::Factory->new;
my $logger = Bio::Phylo::Util::Logger->new;

{

    sub set_datasource {
        my $self = shift;
        return parse( '-project' => $self, @_ );
    }

    my $TYPE       = _PROJECT_;
    my $TAXA       = _TAXA_;
    my $FOREST     = _FOREST_;
    my $MATRIX     = _MATRIX_;
    my $get_object = sub {
        my ( $self, $CONSTANT ) = @_;
        my @result;
        for my $ent ( @{ $self->get_entities } ) {
            if ( $ent->_type == $CONSTANT ) {
                push @result, $ent;
            }
        }
        return \@result;
    };

    sub get_taxa {
        my $self = shift;
        return $get_object->( $self, $TAXA );
    }

    sub get_forests {
        my $self = shift;
        return $get_object->( $self, $FOREST );
    }

    sub get_matrices {
        my $self = shift;
        return $get_object->( $self, $MATRIX );
    }

    sub get_document {
        my $self = shift;
        my $dom  = $_[0];
        my @args = @_;

        # handle dom factory object...
        if ( looks_like_instance( $dom, 'SCALAR' )
            && $dom->_type == _DOMCREATOR_ )
        {
            splice( @args, 0, 1 );
        }
        else {
            $dom = $Bio::Phylo::NeXML::DOM::DOM;
            unless ($dom) {
                throw 'BadArgs' => 'DOM factory object not provided';
            }
        }
        ###	# make sure argument handling works here...
        my $empty = shift @args;
        my $doc   = $dom->create_document();
        my $root;
        unless ($empty) {
            $root = $self->to_dom($dom);
            $doc->set_root($root);
        }
        return $doc;
    }

    sub get_attributes {
        my $self     = shift;
        my $class    = ref($self);
        my $version  = $class->VERSION;
        my %defaults = (
            'version'            => _NEXML_VERSION_,
            'generator'          => "$class v.$version",
            'xmlns'              => _NS_NEXML_,
            'xsi:schemaLocation' => _NS_NEXML_ . ' '
              . _NS_NEXML_
              . '/nexml.xsd',
        );
        my %attrs = ( %defaults, %{ $self->SUPER::get_attributes } );
        return \%attrs;
    }

    sub is_identifiable { 0 }

    sub _add_project_metadata {
        my $self = shift;
        $self->set_namespaces( 'dc' => _NS_DC_ );
        if ( my $user = $ENV{'USER'} ) {
            $logger->debug("adding user metadata '${user}'");
            $self->add_meta(
                $fac->create_meta( '-triple' => { 'dc:creator' => $user } ) );
        }
        eval { require DateTime };
        if ( not $@ ) {
            my $now = DateTime->now();
            $logger->debug("adding timestamp metadata '${now}'");
            $self->add_meta(
                $fac->create_meta( '-triple' => { 'dc:date' => $now } ) );
        }
        else {
            undef($@);
        }
        if ( my $desc = $self->get_desc ) {
            $logger->debug("adding description metadata '${desc}'");
            $self->add_meta(
                $fac->create_meta( '-triple' => { 'dc:description' => $desc } )
            );
        }
    }

    sub to_xml {
        my $self = shift;

        # creating opening tags
        $self->_add_project_metadata;
        my $xml = $self->get_xml_tag;
        $logger->debug("created opening structure ${xml}");

        # processing contents
        my @linked = ( @{ $self->get_forests }, @{ $self->get_matrices } );
        $logger->debug("fetched linked objects @linked");

        # writing out taxa blocks and linked objects
        my %taxa = map { $_->get_id => $_ } @{ $self->get_taxa },
          map { $_->make_taxa } @linked;
        for ( values %taxa, @linked ) {
            $logger->debug("writing $_ to xml");
            $xml .= $_->to_xml(@_);
        }
        $xml .= '</' . $self->get_tag . '>';

        # done creating xml strings
        $logger->debug($xml);
        eval { require XML::Twig };
        if ( not $@ ) {
            my $twig = XML::Twig->new( 'pretty_print' => 'indented' );
            eval { $twig->parse($xml) };
            if ($@) {
                throw 'API' => "Couldn't build xml: " . $@ . "\n\n$xml";
            }
            else {
                return $twig->sprint;
            }
        }
        else {
            undef $@;
            return $xml;
        }
    }

    sub to_nexus {
        my $self   = shift;
        my $nexus  = "#NEXUS\n";
        my @linked = ( @{ $self->get_forests }, @{ $self->get_matrices } );
        my %taxa   = map { $_->get_id => $_ } @{ $self->get_taxa },
          map { $_->make_taxa } @linked;
        for ( values %taxa, @linked ) {
            $nexus .= $_->to_nexus(@_);
        }
        return $nexus;
    }

    sub to_dom {
        my ( $self, $dom ) = @_;
        $dom ||= Bio::Phylo::NeXML::DOM->get_dom;
        unless ( looks_like_object $dom, _DOMCREATOR_ ) {
            throw 'BadArgs' => 'DOM factory object not provided';
        }
        my $elt    = $self->get_dom_elt($dom);
        my @linked = ( @{ $self->get_forests }, @{ $self->get_matrices } );
        my %taxa   = map { $_->get_id => $_ } @{ $self->get_taxa },
          map { $_->make_taxa } @linked;
        for ( values %taxa, @linked ) {
            $elt->set_child( $_->to_dom( $dom, @_ ) );
        }
        return $elt;
    }
    sub _type { $TYPE }
    sub _tag  { 'nex:nexml' }

    # podinherit_insert_token

}