The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# ABSTRACT: Configuration for a MongoDBI Document Class

use strict;
use warnings;

package MongoDBI::Document::Config;
{
  $MongoDBI::Document::Config::VERSION = '0.0.12';
}

use 5.001000;

our $VERSION = '0.0.12'; # VERSION

use Moose::Role; # is trait (++ :)



has _mongo_connection => (
    is      => 'rw',
    isa     => 'MongoDB::Connection'
);


has _mongo_collection => (
    is      => 'rw',
    isa     => 'MongoDB::Collection'
);


has collection => (
    is      => 'rw',
    isa     => 'HashRef',
    lazy    => 1,
    default => sub { {} }
);


has database => (
    is      => 'rw',
    isa     => 'HashRef',
    lazy    => 1,
    default => sub { {} }
);


has fields => (
    is      => 'rw',
    isa     => 'HashRef',
    default => sub { {} }
);


has indexes => (
    is      => 'rw',
    isa     => 'ArrayRef',
    default => sub { [] }
);


has options => (
    is      => 'rw',
    isa     => 'HashRef',
    lazy    => 1,
    default => sub { { safe => 1 } }
);


has searches  => (
    is      => 'rw',
    isa     => 'HashRef',
    default => sub { {} }
);


sub set_collection {
    my ($self, @args) = @_;
    
    my %args = @args == 1 ? (name => $args[0]) : @args;
    
    $args{name}
        ||= $self->collection->{name}
        ||  delete $self->collection->{db_name}
        ||  $self->associated_class->{package};
    
    my %naming_template = (
        same       => sub { $_[0] },
        short      => sub { $_[0] =~ s{^.*\:\:(.*?)$}{$1}g; $_[0] },
        plural     => sub { $_[0] =~ s{^.*\:\:(.*?)$}{$1}g; lc "$_[0]s" },
        decamel    => sub { $_[0] =~ s{([a-z])([A-Z])}{$1_$2}g; lc $_[0] },
        undercolon => sub { $_[0] =~ s{\:\:}{_}g; lc $_[0] },
        lower      => sub { lc $_[0] },
        lc         => sub { lc $_[0] },
        upper      => sub { uc $_[0] },
        uc         => sub { uc $_[0] },
        default    => sub {
            $_[0] =~ s{([a-z])([A-Z])}{$1_$2}g;
            $_[0] =~ s{\:\:}{_}g;
            lc "$_[0]s";
        }
    );
    
    # handle naming conventions
    $args{naming}
        ||= $self->collection->{naming}
        ||  'default';
        
    $args{naming} = [$args{naming}] unless "ARRAY" eq ref $args{naming};
    
    foreach my $template (@{$args{naming}}) {
        $args{name} = $naming_template{$template}->($args{name});
    }
    
    $self->collection->{$_} = $args{$_} for keys %args;
    
    return $self;
}


sub set_database {
    my ($self, @args) = @_;
    
    my %args = @args == 1 ? (name => $args[0]) : @args;
    
    $args{name} ||= $self->database->{name};
    $args{host} ||= '127.0.0.1';
    
    die "Please specify the name of the database" unless $args{name};
    
    $self->database->{$_} = $args{$_} for keys %args;
    
    return $self;
}

1;
__END__
=pod

=head1 NAME

MongoDBI::Document::Config - Configuration for a MongoDBI Document Class

=head1 VERSION

version 0.0.12

=head1 SYNOPSIS

    package main;

    my $cds = CDDB::Album;
    
    $cds->config->set_collection('some_classes');
    $cds->config->set_database('test');
    
    $cds->config->options->{safe} = 0; # on error, continue
    
    1;

=head1 DESCRIPTION

MongoDBI::Document::Config is a trait attached to the MongoDBI configuration
object created with/for each document class.

=head1 ATTRIBUTES

=head2 _mongo_connection

The _mongo_connection attribute contains the L<MongoDB::Connection> object of
the current class. Access it directly as follows:

    package main;

    my $cds = CDDB::Album;
    
    $cds->config->_mongo_connection;

=head2 _mongo_collection

The _mongo_collection attribute contains the L<MongoDB::Collection> object of
the current class. Access it directly as follows:

    package main;

    my $cds = CDDB::Album;
    
    $cds->config->_mongo_collection;

=head2 collection

The collection attribute contains the L<MongoDB::Collection> attributes used to
create the object. Access it directly as follows:

    package main;

    my $cds = CDDB::Album;
    
    $cds->config->collection;
    
    # get collection name
    $cds->config->collection->{name};

=head2 database

The database attribute contains the L<MongoDB::Database> attributes used to
create the object. Access it directly as follows:

    package main;

    my $cds = CDDB::Album;
    
    $cds->config->database;
    
    # get database name
    $cds->config->database->{name};

=head2 fields

The fields attribute contains a hashref of field configurations generated by the
key() keyword. Learn more about the key() keyword at L<MongoDBI::Document::Sugar>.
Access the fields attribute directly as follows:

    package main;

    my $cds = CDDB::Album;
    
    $cds->config->field;
    
    # get field info
    $cds->config->fields->{$name};
    
    print $cds->config->fields->{$name}->{is};
    print $cds->config->fields->{$name}->{isa};

=head2 indexes

The indexes attribute contains a hashref of index configurations generated by the
index() keyword. Learn more about the index() keyword at
L<MongoDBI::Document::Sugar>. Access the indexes attribute directly as follows:

    package main;

    my $cds = CDDB::Album;
    
    $cds->config->indexes;
    
    # run through all indexes
    for (@{$cds->config->indexes}) {
        ...
    }
    
    # print field names of the first registered index
    print $_ for keys $cds->config->indexes->[0]->[0]; 

=head2 options

The options attribute may contains the arguments that will be passed to the
L<MongoDB::Collection> collection altering operations such as insert, update,
remove and save.

Note: Setting this attribute will affect those collection altering operations.
Note: Safe Mode is enabled by default!

Access it directly as follows:

    package main;

    my $cds = CDDB::Album;
    
    $cds->config->options->{safe} = 0;

=head2 searches

The searches attribute contains a hashref of filter specifications generated by
the filter() keyword. Learn more about the filter() keyword at
L<MongoDBI::Document::Sugar>. Access the searches attribute directly as follows:

    package main;

    my $cds = CDDB::Album;
    
    $cds->config->searches;
    
    # get search routine
    $cds->config->searches->{$name};
    
    # execute a search routine
    my $search = $cds->config->search->{$name}->($cds->config->search);

=head1 METHODS

=head2 set_collection

The set_collection method stashes the attributes that will used to create a
L<MongoDB::Collection> object when the database connection is made. Utilize this
method as follows:

    package main;

    my $cds = CDDB::Album;
    
    $cds->config->set_collection('albums');
    
    # semantically correct
    $cds->config->set_database(name => 'albums');
    
    # sophisticated version
    $cds->config->set_database(name => $cds, naming => [
        short, plural, decamel
    ]);
    
    # valid naming convention keys are:
    
    * same - as-is
    * short - only the final portion of the package name
    * plural - unintelligent 's' adder
    * decamel - MyApp becomes my_app
    * undercolon - :: becomes _
    * lower/lc - lowercase string
    * upper/uc - uppercase string
    * default - same as (decamel, undercolon, lower, plural)

=head2 set_database

The set_database method stashes the attributes that will used to create a
L<MongoDB::Database> object when the database connection is made. Utilize this
method as follows:

    package main;

    my $cds = CDDB::Album;
    
    $cds->config->set_database('test');
    
    # semantically correct
    $cds->config->set_database(name => 'test');

=head1 AUTHOR

Al Newkirk <awncorp@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by awncorp.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut