view release on metacpan or  search on metacpan

lib/Meerkat/Role/Document.pm  view on Meta::CPAN

        $type => (
            expand   => sub { shift },
            collapse => sub { shift },
        )
    );
}

#pod =method new
#pod
#pod B<Don't call this directly!>  Create objects through the
#pod L<Meerkat::Collection> or they won't be added to the database.
#pod
#pod     my $obj = $person->create( name => "Joe" );
#pod
#pod =cut

has _collection => (
    is       => 'ro',
    isa      => 'Meerkat::Collection',
    required => 1,
);

has _id => (
    is      => 'ro',
    isa     => 'BSON::OID',
    default => sub { BSON::OID->new },
);

has _removed => (
    is      => 'rw',
    isa     => 'Bool',
    reader  => 'is_removed',
    writer  => '_set_removed',
    default => 0,
);

#pod =method update
#pod
#pod     $obj->update( { '$set' => { 'name' => "Moe" } } );
#pod
#pod Executes a MongoDB update command on the associated document and updates the
#pod object's attributes.  You must only use MongoDB L<update
#pod operators|http://docs.mongodb.org/manual/reference/operator/nav-update/> to
#pod modify the document's fields.
#pod
#pod Returns true if the updates are applied and synchronized.  If the document has
#pod been removed, the method returns false and the object is marked as removed;
#pod subsequent C<update>, C<sync> or C<remove> calls will do nothing and return
#pod false.
#pod
#pod This command is intended for custom updates with unusual logic or operators.
#pod Many typical updates can be accomplished with the C<update_*> methods described
#pod below.
#pod
#pod For all update methods, you can use a MongoDB nested field label to modify
#pod values deep into a data structure. For example C<parents.father> refers to
#pod C<< $obj->parents->{father} >>.
#pod
#pod =cut

sub update {
    state $check = compile( Object, HashRef );
    my ( $self, $update ) = $check->(@_);
    croak "The update method only accepts MongoDB update operators"
      if grep { /^[^\$]/ } keys %$update;
    return if $self->is_removed; # NOP
    return $self->_collection->update( $self, $update );
}

#pod =method update_set
#pod
#pod     $obj->update_set( name => "Luke Skywalker" );
#pod
#pod Sets a field to a value.  This is the MongoDB C<$set> operator.
#pod
#pod The field must be undefined or else the existing value and the new value must
#pod be of similar types (e.g. scalar or array or hash).  For the purpose of this
#pod check, an object (e.g. a DateTime) is treated (opaquely) as a scalar value.  If
#pod the types do not match, an error will be thrown.
#pod
#pod Note this means that you can't set a defined value to undefined.  To remove a
#pod field entirely, see L</update_clear>.  If you need to make other structural
#pod changes, do it manually with the L</update> method.
#pod
#pod Returns true if the update is applied and synchronized.  If the document has
#pod been removed, the method returns false and the object is marked as removed.
#pod
#pod =cut

sub update_set {
    state $check = compile( Object, Defined, Defined );
    my ( $self, $field, $value ) = $check->(@_);
    $self->__check_op( $field, any(qw/undef scalar object ARRAY HASH/) );
    my $type        = $self->__field_type( $self->_deep_field($field) );
    my $target_type = $self->__field_type($value);
    croak "Can't use update_set to change $type field '$field' to $target_type"
      if $type eq none(qw/undef object/) && $type ne $target_type;

    return $self->update( { '$set' => { "$field" => $value } } );
}

#pod =method update_inc
#pod
#pod     $obj->update_inc( likes => 1 );
#pod     $obj->update_inc( likes => -1 );
#pod
#pod Increments a field by a positive or negative value.  This is the MongoDB
#pod C<$inc> operator.  The field must be undefined or a numeric scalar value
#pod or an error will be thrown.
#pod
#pod Returns true if the update is applied and synchronized.  If the document has
#pod been removed, the method returns false and the object is marked as removed.
#pod
#pod =cut

sub update_inc {
    state $check = compile( Object, Defined, Defined );
    my ( $self, $field, $value ) = $check->(@_);
    $self->__check_op( $field, any(qw/undef scalar/) );
    my $current = $self->$field;
    croak "Can't use update_inc on non-numeric field '$field'"
      if defined $current && !looks_like_number($current);
    return $self->update( { '$inc' => { "$field" => $value } } );
}

#pod =method update_push
#pod
#pod     $obj->update_push( tags => qw/cool hot trendy/ );
#pod
#pod Pushes values onto an array reference field. This is the MongoDB C<$push>
#pod operator.  The field must be undefined or an array reference or an error
#pod is thrown.
#pod
#pod Returns true if the update is applied and synchronized.  If the document has
#pod been removed, the method returns false and the object is marked as removed.
#pod
#pod
#pod =cut

sub update_push {
    state $check = compile( Object, Defined, slurpy ArrayRef );
    my ( $self, $field, $list ) = $check->(@_);
    $self->__check_op( $field, any(qw/undef ARRAY/) );
    return $self->update( { '$push' => { "$field" => { '$each' => $list } } } );
}

#pod =method update_add
#pod
#pod     $obj->update_add( tags => qw/cool hot trendy/ );
#pod
#pod Pushes values onto an array reference field, but only if they do not already
#pod exist in the array.  This is the MongoDB C<$addToSet> operator.  The field
#pod must be undefined or an array reference or an error is thrown.
#pod
#pod Returns true if the update is applied and synchronized.  If the document has
#pod been removed, the method returns false and the object is marked as removed.
#pod
#pod =cut

sub update_add {
    state $check = compile( Object, Defined, slurpy ArrayRef );
    my ( $self, $field, $list ) = $check->(@_);
    $self->__check_op( $field, any(qw/undef ARRAY/) );
    return $self->update( { '$addToSet' => { "$field" => { '$each' => $list } } } );
}

#pod =method update_pop
#pod
#pod     $obj->update_pop( 'tags' );
#pod
#pod Removes a value from the end of the array.  This is the MongoDB C<$pop>
#pod operator with a direction of "1".    The field must be undefined or an array
#pod reference or an error is thrown.
#pod
#pod Returns true if the update is applied and synchronized.  If the document has
#pod been removed, the method returns false and the object is marked as removed.
#pod
#pod =cut

sub update_pop {
    state $check = compile( Object, Defined );
    my ( $self, $field ) = $check->(@_);
    $self->__check_op( $field, any(qw/undef ARRAY/) );
    return $self->update( { '$pop' => { "$field" => 1 } } );
}

#pod =method update_shift
#pod
#pod     $obj->update_shift( 'tags' );
#pod
#pod Removes a value from the front of the array.  This is the MongoDB C<$pop>
#pod operator with a direction of "-1".   The field must be undefined or an array
#pod reference or an error is thrown.
#pod
#pod Returns true if the update is applied and synchronized.  If the document has
#pod been removed, the method returns false and the object is marked as removed.
#pod
#pod
#pod =cut

sub update_shift {
    state $check = compile( Object, Defined );
    my ( $self, $field ) = $check->(@_);
    $self->__check_op( $field, any(qw/undef ARRAY/) );
    return $self->update( { '$pop' => { "$field" => -1 } } );
}

#pod =method update_remove
#pod
#pod     $obj->update_remove( tags => qw/cool hot/ );
#pod
#pod Removes a list of values from the array.  This is the MongoDB C<$pullAll>
#pod operator.   The field must be undefined or an array reference or an error is
#pod thrown.
#pod
#pod Returns true if the update is applied and synchronized.  If the document has
#pod been removed, the method returns false and the object is marked as removed.
#pod
#pod
#pod =cut

sub update_remove {
    state $check = compile( Object, Defined, slurpy ArrayRef );
    my ( $self, $field, $list ) = $check->(@_);
    $self->__check_op( $field, any(qw/undef ARRAY/) );
    return $self->update( { '$pullAll' => { "$field" => $list } } );
}

#pod =method update_clear
#pod
#pod     $obj->update_clear( 'tags' );
#pod
#pod Removes a field from a document.  This is the MongoDB C<$unset> operator.
#pod Returns true if the update is applied and synchronized.  If the document has
#pod been removed, the method returns false and the object is marked as removed.
#pod
#pod Be sure not to clear any required fields.
#pod
#pod =cut

sub update_clear {
    state $check = compile( Object, Defined );
    my ( $self, $field ) = $check->(@_);
    $self->__check_op( $field, any(qw/undef scalar object ARRAY HASH/) );
    return $self->update( { '$unset' => { "$field" => undef } } );
}

#pod =method sync
#pod
#pod     $obj->sync;
#pod
#pod Updates object attributes from the database.  Returns true if synced.  If the
#pod document has been removed, the method returns false and the object is marked as
#pod removed; subsequent C<update>, C<sync> or C<remove> calls will do nothing and
#pod return false.
#pod
#pod =cut

sub sync {
    state $check = compile(Object);
    my ($self) = $check->(@_);
    return $self->_collection->sync($self);
}

#pod =method remove
#pod
#pod     $obj->remove;
#pod
#pod Removes the associated document from the database.  The object is marked as
#pod removed; subsequent C<update>, C<sync> or C<remove> calls will do nothing and
#pod return false.
#pod
#pod =method is_removed
#pod
#pod     if ( $obj->is_removed ) { ... }
#pod
#pod Returns true or false indicating whether the associated document was removed
#pod from the database.
#pod
#pod =cut

sub remove {
    state $check = compile(Object);
    my ($self) = $check->(@_);
    return 1 if $self->is_removed; # NOP
    return $self->_collection->remove($self);
}

#pod =method reinsert
#pod
#pod     $obj->reinsert;
#pod     $obj->reinsert( force => 1 );
#pod
#pod Reinserts a removed document.  If the C<force> option is true, then it will be
#pod reinserted even if the document has not been removed, overwriting any existing
#pod document in the database.  Returns false if the document is not removed (unless
#pod the force option is true).  Returns true if the document has been reinserted.
#pod
#pod =cut

sub reinsert {