view release on metacpan or  search on metacpan

lib/DBIx/Locker/Lock.pm  view on Meta::CPAN

use strict;
use warnings;
use 5.008;
# ABSTRACT: a live resource lock

package DBIx::Locker::Lock 1.103;

use Carp ();
use Sub::Install ();

#pod =method new
#pod
#pod B<Calling this method is a very, very stupid idea.>  This method is called by
#pod L<DBIx::Locker> to create locks.  Since you are not a locker, you should not
#pod call this method.  Seriously.
#pod
#pod   my $locker = DBIx::Locker::Lock->new(\%arg);
#pod
#pod This returns a new lock. 
#pod
#pod   locker     - the locker creating the lock
#pod   lock_id    - the id of the lock in the lock table
#pod   expires    - the time (in epoch seconds) at which the lock will expire
#pod   locked_by  - a hashref of identifying information
#pod   lockstring - the string that was locked
#pod
#pod =cut

sub new {
  my ($class, $arg) = @_;

  my $guts = {
    is_locked => 1,
    locker    => $arg->{locker},
    lock_id   => $arg->{lock_id},
    expires   => $arg->{expires},
    locked_by => $arg->{locked_by},
    lockstring => $arg->{lockstring},
  };

  return bless $guts => $class;
}

#pod =method locker
#pod
#pod =method lock_id
#pod
#pod =method locked_by
#pod
#pod =method lockstring
#pod
#pod These are accessors for data supplied to L</new>.
#pod
#pod =cut

BEGIN {
  for my $attr (qw(locker lock_id locked_by lockstring)) {
    Sub::Install::install_sub({
      code => sub {
        Carp::confess("$attr is read-only") if @_ > 1;
        $_[0]->{$attr}
      },
      as   => $attr,
    });
  }
}

#pod =method expires
#pod
#pod This method returns the expiration time (as a unix timestamp) as provided to
#pod L</new> -- unless expiration has been changed.  Expiration can be changed by
#pod using this method as a mutator:
#pod
#pod   # expire one hour from now, no matter what initial expiration was
#pod   $lock->expires(time + 3600);
#pod
#pod When updating the expiration time, if the given expiration time is not a valid
#pod unix time, or if the expiration cannot be updated, an exception will be raised.
#pod
#pod =cut

sub expires {
  my $self = shift;
  return $self->{expires} unless @_;

  my $new_expiry = shift;

  Carp::confess("new expiry must be a Unix epoch time")
    unless $new_expiry =~ /\A\d+\z/;

  my $time_array = [ localtime $new_expiry ];

  my $dbh   = $self->locker->dbh;
  my $table = $self->locker->table;

  my $rows  = $dbh->do(
    "UPDATE $table SET expires = ? WHERE id = ?",
    undef,
    $self->locker->_time_to_string($time_array),
    $self->lock_id,
  );