view release on metacpan or  search on metacpan

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

See parse_data method for return contexts.

=over

=item * $schema

The schema/context/prefix of the lookup.. eg "throttle" for throttle tables

=item * $table

The table/suffix of the lookup .. eg "sender_domain" for the "throttle_sender_domain" table

=item * $search_ref

HashRef of search attributes. Can be flat or nested

    $search_ref = { attribute => "value" }; # simple equals
    $search_ref = { attribute => { ">" => 123 } }; # complex "greater then"

=back


=head2 set $schema, $table, $search_ref, $data_ref

Writes to database. Could affect multiple entries.

=over

=item * $schema, $table, $search_ref

Set get method

=item * $data_ref

HashRef or scalar of the data to be saved. If scalar, it is will be converted into { data => "scalar" } 

=back


=head2 search $schema, $table, $search_ref

Returns a list of search results (in opposite to the get method). In scalar contexts it returns an ArrayRef instead

=over

=item * $schema, $table, $search_ref

Set get method

=back

=cut


=head2 update_data

Transforms flat (scalar) values into { data => $value } hashrefs

=cut

sub update_data {
    my ( $self, $data ) = @_;
    return $data if ref( $data );
    return { data => $data };
}

=head2 parse_data $data_ref

Transforms hashref values in an array context from { value => $value } to ( $value )

In array-context, it will return the content of the "data" field, if any

Can be modified in derived modules.

=cut

sub parse_data {
    my ( $self, $data ) = @_;
    return unless defined $data;
    return wantarray ? ( $data ) : { data => $data } unless ref( $data );
    return wantarray ? ( $data->{ data } ) : $data;
}



=head2 update_query $query_ref

Update method for search query. Can be overwritten/extended in derived modules.

=cut

sub update_query {
    my ( $self, $query_ref ) = @_;
    return $query_ref if ref( $query_ref );
    return { key => $query_ref };
}


=head2 do_lock

Locks via flock file

=cut

sub do_lock {
    my ( $self, $num ) = @_;
    $num ||= 0;
    
    my $locker = $self->locker;
    
    # !! ATTENTION !!
    #   the purpose of this locking is to ensure increments in multi-forking
    #   environment work. The purpose is NOT to assure absolute mutual
    #   exclusion. 
    #   worst case for data: some counter are not incremented
    #   worst case for process: slow response (not to speak of deadlock)
    #   the process needs overrule the (statistic) data needs.
    # !! ATTENTION !!
    my $deadlock = 1_500_000; # = 1.5 sec
    eval {
        $SIG{ ALRM } = sub {
            die "Deadlock timeout\n";
        };
        ualarm( $deadlock );
        $locker->op( $num, -1, 0 );
        ualarm( 0 );
    };
    if ( $@ ) {
        $locker->setval( $num, 0 );
        warn "Deadlock in $num blighted\n";
    }
}


=head2 do_unlock

Unlocks the flock

=cut

sub do_unlock {
    my ( $self, $num ) = @_;
    $num ||= 0;
    #$self->locker->write( 0, 0, 1 );
    $self->locker->op( $num, 1, 0 );
}

=head2 read_lock

Do read lock

=cut