libmongodbx-class-perl 1.02-3 / usr / share / perl5 / MongoDBx / Class / Connection.pm

package MongoDBx::Class::Connection;

# ABSTARCT: A connection to a MongoDB server

our $VERSION = "1.02";
$VERSION = eval $VERSION;

use Moose;
use namespace::autoclean;
use Module::Load;
use version;

if (version->parse($MongoDB::VERSION) < v0.502.0) { 
	extends 'MongoDB::Connection';
} else {
	extends 'MongoDB::MongoClient';
}

=head1 NAME

MongoDBx::Class::Connection - A connection to a MongoDB server

=head1 VERSION

version 1.02

=head1 EXTENDS

L<MongoDB::Connection>

=head1 SYNOPSIS

	# connect to a MongoDB server
	my $conn = $mongodbx->connect(host => '10.10.10.10', port => 27017);

	# the connection object is automatically saved to the 'conn'
	# attribute of the L<MongoDBx::Class> object (C<$mongodbx> above)

	$conn->get_database('people');

=head1 DESCRIPTION

MongoDBx::Class::Connection extends L<MongoDB::Connection>. This class
provides the document expansion and collapsing methods that are used
internally by other MongoDBx::Class classes.

Note that a L<MongoDBx::Class> object can only have one connection at a
time. Connection is only made via the C<connect()> method in MongoDBx::Class.

=head1 ATTRIBUTES

Aside for attributes provided by L<MongoDB::Connection>, the following
special attributes are added:

=head2 namespace

A string representing the namespace of document classes to load (e.g.
MyApp::Schema). This is a required attribute (automatically received from
the MongoDBx::Class object).

=head2 doc_classes

A hash-ref of document classes loaded. This is a required attribute
(automatically received from the MongoDBx::Class object).

=head2 safe

A boolean value indicating whether to use safe operations (e.g. inserts
and updates) by default - without the need to pass C<< { safe => 1 } >> to
relevant methods - or not. False by default.

=head2 is_backup

This boolean attribute is used by L<MongoDBx::Class::ConnectionPool> objects
that use a backup connection.

=cut

has 'namespace' => (is => 'ro', isa => 'Str', required => 1);

has 'doc_classes' => (is => 'ro', isa => 'HashRef', required => 1);

has 'safe' => (is => 'rw', isa => 'Bool', default => 0);

has 'is_backup' => (is => 'ro', isa => 'Bool', default => 0);

=head1 OBJECT METHODS

Aside from the methods provided by L<MongoDB::Connection>, the following
methods and modifications are added:

=head2 get_database( $name )

Returns a L<MongoDBx::Class::Database> object representing the MongoDB
database named C<$name>.

=cut

override 'get_database' => sub {
	my $conn_key = version->parse($MongoDB::VERSION) < v0.502.0 ? '_connection' : '_client';

	MongoDBx::Class::Database->new($conn_key => shift, name => shift);
};

=head2 safe( $boolean )

Overrides the current value of the safe attribute with a new boolean value.

=head2 expand( $coll_ns, \%doc )

Receives the full name (a.k.a namespace) of a collection (that is the database
name, followed by a dot, and the collection name), and a document hash-ref,
and attempts to expand it according to the '_class' attribute that should
exist in the document. If it doesn't exist, the document is returned as
is.

This is mostly used internally and you don't have to worry about expansion,
it's done automatically.

=cut

sub expand {
	my ($self, $coll_ns, $doc) = @_;

	# make sure we've received the namespace and a hash-ref document
	return unless $coll_ns && $doc && ref $doc eq 'HASH';

	# extract the database name and the collection name from the namespace
	my ($db_name, $coll_name) = ($coll_ns =~ m/^([^.]+)\.(.+)$/);

	# get the collection
	my $coll = $self->get_database($db_name)->get_collection($coll_name);

	# return the document as is if it doesn't have a _class attribute
	return $doc unless $doc->{_class};

	# remove the schema namespace from the document class (we do not
	# use the full package name internally) and attempt to find that
	# document class. return the document as is if class isn't found
	my $dc_name = $doc->{_class};
	my $ns = $self->namespace;
	$dc_name =~ s/^${ns}:://;

	my $dc = $self->doc_classes->{$dc_name};

	return $doc unless $dc;

	# start building the document object
	my %attrs = (
		_collection => $coll,
		_class => $doc->{_class},
	);

	foreach ($dc->meta->get_all_attributes) {
		# is this a MongoDBx::Class::Reference?
		if ($_->{isa} eq 'MongoDBx::Class::CoercedReference') {
			my $name = $_->name;
			$name =~ s!^_!!;
			
			next unless exists $doc->{$name} &&
				    defined $doc->{$name} && 
				    ref $doc->{$name} eq 'HASH' &&
				    exists $doc->{$name}->{'$ref'} &&
				    exists $doc->{$name}->{'$id'};

			$attrs{$_->name} = MongoDBx::Class::Reference->new(
				_collection => $coll,
				_class => 'MongoDBx::Class::Reference',
				ref_coll => $doc->{$name}->{'$ref'},
				ref_id => $doc->{$name}->{'$id'},
			);
		# is this an array-ref of MongoDBx::Class::References?
		} elsif ($_->{isa} eq 'ArrayOfMongoDBx::Class::CoercedReference') {
			my $name = $_->name;
			$name =~ s!^_!!;

			next unless exists $doc->{$name} &&
				    defined $doc->{$name} && 
				    ref $doc->{$name} eq 'ARRAY';

			foreach my $ref (@{$doc->{$name}}) {
				push(@{$attrs{$_->name}}, MongoDBx::Class::Reference->new(
					_collection => $coll,
					_class => 'MongoDBx::Class::Reference',
					ref_coll => $ref->{'$ref'},
					ref_id => $ref->{'$id'},
				));
			}
		# is this an embedded document (or array-ref of embedded documents)?			
		} elsif ($_->documentation && $_->documentation eq 'MongoDBx::Class::EmbeddedDocument') {
			my $edc_name = $_->{isa};
			$edc_name =~ s/^${ns}:://;
			if ($_->{isa} =~ m/^ArrayRef/) {
				my $name = $_->name;
				$name =~ s!^_!!;
				
				$edc_name =~ s/^ArrayRef\[//;
				$edc_name =~ s/\]$//;

				next unless exists $doc->{$name} &&
					    defined $doc->{$name} && 
					    ref $doc->{$name} eq 'ARRAY';

				$attrs{$_->name} = [];

				foreach my $a (@{$doc->{$name}}) {
					$a->{_class} = $edc_name;
					push(@{$attrs{$_->name}}, $self->expand($coll_ns, $a));
				}
			} elsif ($_->{isa} =~ m/^HashRef/) {
				my $name = $_->name;
				$name =~ s!^_!!;
				
				$edc_name =~ s/^HashRef\[//;
				$edc_name =~ s/\]$//;

				next unless exists $doc->{$name} &&
					    defined $doc->{$name} && 
					    ref $doc->{$name} eq 'HASH';
				
				$attrs{$_->name} = {};
				
				foreach my $key (keys %{$doc->{$name}}) {
					$doc->{$name}->{$key}->{_class} = $edc_name;
					$attrs{$_->name}->{$key} = $self->expand($coll_ns, $doc->{$name}->{$key});
				}
			} else {
				next unless exists $doc->{$_->name} && defined $doc->{$_->name};
				$doc->{$_->name}->{_class} = $edc_name;
				$attrs{$_->name} = $self->expand($coll_ns, $doc->{$_->name});
			}
		# is this an expanded attribute?
		} elsif ($_->can('does') && $_->does('Parsed') && $_->parser) {
			next unless exists $doc->{$_->name} && defined $doc->{$_->name};
			load $_->parser;
			my $val = $_->parser->new->expand($doc->{$_->name});
			$attrs{$_->name} = $val if defined $val;
		# is this a transient attribute?
		} elsif ($_->can('does') && $_->does('Transient')) {
			next;
		# just pass the value as is
		} else {
			next unless exists $doc->{$_->name} && defined $doc->{$_->name};
			$attrs{$_->name} = $doc->{$_->name};
		}
	}

	return $dc->new(%attrs);
}

=head2 collapse( \%doc )

Receives a document hash-ref and returns a collapsed version of it such
that it can be safely inserted to the database. For example, you can't
save an embedded document directly to the database, you need to convert
it to a hash-ref first.

This method is mostly used internally and you don't have to worry about
collapsing, it's done automatically.

=cut

sub collapse {
	my ($self, $doc) = @_;

	# return the document as is if it doesn't have a _class attribute
	return $doc unless $doc->{_class};

	# remove the schema namespace from the document class (we do not
	# use the full package name internally) and attempt to find that
	# document class. return the document as is if class isn't found
	my $dc_name = $doc->{_class};
	my $ns = $self->namespace;
	$dc_name =~ s/^${ns}:://;

	my $dc = $self->doc_classes->{$dc_name};

	my $new_doc = { _class => $doc->{_class} };

	foreach (keys %$doc) {
		next if $_ eq '_class';

		my $attr = $dc->meta->get_attribute($_);
		if ($attr && $attr->can('does') && $attr->does('Parsed') && $attr->parser) {
			load $attr->parser;
			my $parser = $attr->parser->new;
			if (ref $doc->{$_} eq 'ARRAY') {
				my @arr;
				foreach my $val (@{$doc->{$_}}) {
					push(@arr, $parser->collapse($val));
				}
				$new_doc->{$_} = \@arr;
			} else {
				$new_doc->{$_} = $parser->collapse($doc->{$_});
			}
		
		} elsif ($attr && $attr->can('does') && $attr->does('Transient')) {
			next;
		} else {
			$new_doc->{$_} = $self->_collapse_val($doc->{$_});
		}
	}

	return $new_doc;
}

=head1 INTERNAL METHODS

=head2 _collapse_val( $val )

=cut

sub _collapse_val {
	my ($self, $val) = @_;

	if (blessed $val && $val->isa('MongoDBx::Class::Reference')) {
		return { '$ref' => $val->ref_coll, '$id' => $val->ref_id };
	} elsif (blessed $val && $val->can('does') && $val->does('MongoDBx::Class::Document')) {
		return { '$ref' => $val->_collection->name, '$id' => $val->_id };
	} elsif (blessed $val && $val->can('does') && $val->does('MongoDBx::Class::EmbeddedDocument')) {
		return $val->as_hashref;
	} elsif (ref $val eq 'ARRAY') {
		my @arr;
		foreach (@$val) {
			if (blessed $_ && $_->isa('MongoDBx::Class::Reference')) {
				push(@arr, { '$ref' => $_->ref_coll, '$id' => $_->ref_id });
			} elsif (blessed $_ && $_->can('does') && $_->does('MongoDBx::Class::Document')) {
				push(@arr, { '$ref' => $_->_collection->name, '$id' => $_->_id });
			} elsif (blessed $_ && $_->can('does') && $_->does('MongoDBx::Class::EmbeddedDocument')) {
				push(@arr, $_->as_hashref);
			} else {
				push(@arr, $_);
			}
		}
		return \@arr;
	} elsif (ref $val eq 'HASH') {
		my $h = {};
		foreach (keys %$val) {
			if (blessed $val->{$_} && $val->{$_}->isa('MongoDBx::Class::Reference')) {
				$h->{$_} = { '$ref' => $val->{$_}->ref_coll, '$id' => $val->{$_}->ref_id };
			} elsif (blessed $val->{$_} && $val->{$_}->can('does') && $val->{$_}->does('MongoDBx::Class::Document')) {
				$h->{$_} = { '$ref' => $val->{$_}->_collection->name, '$id' => $val->{$_}->_id };
			} elsif (blessed $val->{$_} && $val->{$_}->can('does') && $val->{$_}->does('MongoDBx::Class::EmbeddedDocument')) {
				$h->{$_} = $val->{$_}->as_hashref;
			} else {
				$h->{$_} = $val->{$_};
			}
		}
		return $h;
	}

	return $val;
}

=head1 AUTHOR

Ido Perlmuter, C<< <ido at ido50.net> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-mongodbx-class at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MongoDBx-Class>. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

	perldoc MongoDBx::Class::Connection

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MongoDBx::Class>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/MongoDBx::Class>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/MongoDBx::Class>

=item * Search CPAN

L<http://search.cpan.org/dist/MongoDBx::Class/>

=back

=head1 SEE ALSO

L<MongoDBx::Class>, L<MongoDB::Connection>.

=head1 LICENSE AND COPYRIGHT

Copyright 2010-2012 Ido Perlmuter.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut

__PACKAGE__->meta->make_immutable;