view release on metacpan or  search on metacpan

lib/Apache/SharedMem.pm  view on Meta::CPAN

    croak("odd number of arguments for object construction")
      if(@_ % 2);
    for(my $x = 0; $x <= $#_; $x += 2)
    {
        croak("Unknown parameter $_[$x] in $pkg object creation")
          unless(exists($options->{lc($_[$x])}));
        $options->{lc($_[$x])} = $_[($x + 1)];
    }

    _init_dumper() if($options->{debug});

    if($options->{rootname})
    {
        carp('obsolete parameter: rootname');
        # delete rootname parameter and if rootkey is undefined, copy the old rootname value in it.
        (defined $options->{rootkey} ? my $devnull : $options->{rootkey}) = delete($options->{rootname});
    }

    $options->{rootkey} = defined($options->{rootkey}) ? $options->{rootkey} : $self->_get_rootkey;

    foreach my $name (qw(namespace rootkey))
    {
        croak("$pkg object creation missing $name parameter.")
          unless(defined($options->{$name}) && $options->{$name} ne '');
    }

    $self->_debug("create Apache::SharedMem instence. options: ", join(', ', map("$_ => " . (defined($options->{$_}) ? $options->{$_} : 'UNDEF'), keys %$options)))
      if($options->{debug});

    $self->_init_namespace || $options->{readonly} || return undef;

    return $self;
}

=pod

=head2 get  (key, [wait, [timeout]])

my $var = $object->get('mykey', WAIT, 50);
if($object->status & FAILURE)
{
    die("can't get key 'mykey´: " . $object->error);
}

=over 4

=item *

C<key> required, string

This is the name of elemenet that you want get from the shared namespace. It can be any string that perl
support for hash's key.

=item *

C<wait> optional

Defined the locking status of the request. If you must get the value, and can't continue without it, set
this argument to constant WAIT, unless you can set it to NOWAIT. 

If the key is locked when you are tring to get the value, NOWAIT return status FAILURE, and WAIT hangup
until the value is unlocked. An alternative is to setup a WAIT timeout, see below.

NOTE: you needs :wait tag import: 

    use Apache::SharedMem qw(:wait)

timeout (optional) integer: 

if WAIT is on, timeout setup the number of seconds to wait for a blocking lock, usefull for preventing 
dead locks.

=back

Following status can be set (needs :status tag import):

SUCCESS FAILURE

On error, method return undef(), but undef() is also a valid answer, so don't test the method status
by this way, use ($obj->status & SUCCESS) instead.

=cut

sub get
{
    my $self    = shift || croak('invalide method call');
    my $key     = defined($_[0]) && $_[0] ne '' ? shift : croak(defined($_[0]) ? 'Not enough arguments for get method' : 'Invalid argument "" for get method');
    my $wait    = defined($_[0]) ? shift : (shift, 1);
    my $timeout = shift;
    croak('Too many arguments for get method') if(@_);
    $self->_unset_error;
    
    $self->_debug("$key ", $wait ? '(wait)' : '(no wait)');

    my($lock_success, $out_lock) = $self->_smart_lock(($wait ? LOCK_SH : LOCK_SH|LOCK_NB), $timeout);
    unless($lock_success)
    {
        $self->_set_error('can\'t get shared lock for "get" method');
        $self->_set_status(FAILURE);
        return(undef());
    }

    # extract datas from the shared memory
    my $share = $self->_get_namespace;

    $self->lock($out_lock, $timeout);

    if(exists $share->{$key})
    {
        $self->_set_status(SUCCESS);
        return($share->{$key}); # can be undef() !
    }
    else
    {
        $self->_set_status(FAILURE);
        $self->_set_error("can't get key $key, it doesn't exists");
        return(undef());
    }
}

=pod