view release on metacpan or  search on metacpan

lib/Mail/Decency/Helper/Database/MongoDB.pm  view on Meta::CPAN

    my ( $res ) = $self->_try_transaction( $schema => $table => remove => [ $search_ref ] );
    $self->write_unlock; # release semaphore
    return $res;
}


=head2 ping

Pings MongoDB Server, check wheter connect possible or not

=cut

sub ping {
    my ( $self, $schema, $table ) = @_;
    
    eval {
        my $col = $self->db->get_collection( "${schema}_${table}" );
    };
    $self->logger->debug0( "Collection '${$schema}_${table}' not existing, yet.. no harm, should be created automatically. Response: $@" )
        if $@;
    
    return 1;
}


=head2 setup

Create database

setup indices

=cut

sub setup {
    my ( $self, $schema, $table, $columns_ref, $execute ) = @_;
    
    if ( $execute ) {
        if ( defined $columns_ref->{ -unique } ) {
            my $unique = Tie::IxHash->new( map { ( $_ => 1 ) } @{ $columns_ref->{ -unique } } );
            $self->db->get_collection( "${schema}_${table}" )->ensure_index( $unique, { unique => 1 } );
        }
        
        if ( defined $columns_ref->{ -index } ) {
            my $idx = Tie::IxHash->new( map { ( $_ => 1 ) } @{ $columns_ref->{ -index } } );
            $self->db->get_collection( "${schema}_${table}" )->ensure_index( $idx );
        }
    }
    
    else {
        print "-- MongoDB does no require create statements\n";
    }
    
    return 1;
}


=head2 update_query

=cut

sub update_query {
    my ( $self, $ref ) = @_;
    $ref = $self->next::method( $ref );
    
    my %op_match = (
        '>'  => '$gt',
        '<'  => '$lt',
        '>=' => '$gte',
        '<=' => '$lte',
        '!=' => '$ne',
    );
    while( my ( $k, $v ) = each %$ref ) {
        my $type = ref( $v );
        next unless $type;
        if ( $type eq 'HASH' ) {
            foreach my $op( keys %$v ) {
                $v->{ $op_match{ $op } } = delete $v->{ $op }
                    if defined $op_match{ $op };
            }
        }
        elsif ( $type eq 'ARRAY' ) {
            $ref->{ $k } = { '$in' => delete $ref->{ $k } };
        }
    }
    
    return $ref;
}


=head2 _try_transaction

Cause mongodb does not handle clean re-connections, this has to be implemented in code

=cut

sub _try_transaction {
    my ( $self, $schema, $table, $method, $args_ref ) = @_;
    
    my @res;
    
    # if mongodb was restarted, this will throw an error
    eval {
        local $SIG{ ALRM } = sub {
            #$self->logger->error( "MongoDB Connection lost, try reconnect" );
            die "Timeout\n";
        };
        ualarm( 1_000_000 );
        @res = $self->db->get_collection( "${schema}_${table}" )->$method( @$args_ref );
        alarm( 0 );
    };
    
    # handle disconnection event
    if ( $@ && ( $@ =~ /not connected/ || $@ =~ /Timeout/ ) ) {
        
        # try connect
        eval { $self->connect; };
        
        # mongo db probably down:
        carp "Cannot connect to MongoDB: $@" if $@;
        
        # fetch again