locked results from the CPAN

locked

DBIx-Locker

view release on metacpan or search on metacpan

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40 0.100117  2014-05-19 17:38:21-04:00 America/New_York
        - Fix tests on DBD::SQLite 1.42 (frew)
 
0.100116  2013-12-17 13:08:36-0500 America/New_York
        - tweak test expectations to allow for multiline unique key error
          (seems to be found in older SQLite?)
 
0.100115  2013-11-27 22:40:10 America/New_York
          Add lockstring method to ::Lock (frew)
 
          Add is_locked flag to ::Lock to make unlock idempotent (frew)
 
0.100114  2013-07-30 18:03:23 America/New_York
          Include errstr from underlying db (frew)
 
          update bugtracker
 
0.100113  2013-07-05 21:13:26 America/New_York
          fix typo, update bugtracker
 
0.100112  2012-11-06 12:01:01 America/New_York

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

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37 #pod ...and a B<warning>.
#pod
#pod DBIx::Locker was written to replace some lousy database resource locking code.
#pod The code would establish a MySQL lock with C<GET_LOCK> to lock arbitrary
#pod resources.  Unfortunately, the code would also silently reconnect in case of
#pod database connection failure, silently losing the connection-based lock.
#pod DBIx::Locker locks by creating a persistent row in a "locks" table.
#pod
#pod Because DBIx::Locker locks are stored in a table, they won't go away.  They
#pod have to be purged regularly.  (A program for doing this, F<dbix_locker_purge>,
#pod is included.)  The locked resource is just a string.  All records in the lock
#pod (or semaphore) table are unique on the lock string.
#pod
#pod This is the I<entire> mechanism.  This is quick and dirty and quite effective,
#pod but it's not highly efficient.  If you need high speed locks with multiple
#pod levels of resolution, or anything other than a quick and brutal solution,
#pod I<keep looking>.
#pod
#pod =head1 STORAGE
#pod
#pod To use this module you'll need to create the lock table, which should have five

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

40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60 #pod =over
#pod
#pod =item * C<id> Autoincrementing ID is recommended
#pod
#pod =item * C<lockstring> varchar(128) with a unique constraint
#pod
#pod =item * C<created> datetime
#pod
#pod =item * C<expires> datetime
#pod
#pod =item * C<locked_by> text
#pod
#pod =back
#pod
#pod See the C<sql> directory included in this dist for DDL for your database.
#pod
#pod =method new
#pod
#pod   my $locker = DBIx::Locker->new(\%arg);
#pod
#pod This returns a new locker.

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

154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208   Carp::confess("no lockstring provided")
    unless defined $lockstring and length $lockstring;
 
  my $expires = $arg->{expires} ||= 3600;
 
  Carp::confess("expires must be a positive integer")
    unless $expires > 0 and $expires == int $expires;
 
  $expires = time + $expires;
 
  my $locked_by = {
    host => Sys::Hostname::hostname(),
    guid => Data::GUID->new->as_string,
    pid  => $$,
  };
 
  my $table = $self->table;
  my $dbh   = $self->dbh;
 
  local $dbh->{RaiseError} = 0;
  local $dbh->{PrintError} = 0;
 
  my $rows  = $dbh->do(
    "INSERT INTO $table (lockstring, created, expires, locked_by)
    VALUES (?, ?, ?, ?)",
    undef,
    $lockstring,
    $self->_time_to_string,
    $self->_time_to_string([ localtime($expires) ]),
    $JSON->encode($locked_by),
  );
 
  die(
    "could not lock resource <$lockstring>" . (
      $dbh->err && $dbh->errstr
        ? (': ' .  $dbh->errstr)
        : ''
    )
  ) unless $rows and $rows == 1;
 
  my $lock = DBIx::Locker::Lock->new({
    locker    => $self,
    lock_id   => $self->last_insert_id,
    expires   => $expires,
    locked_by => $locked_by,
    lockstring => $lockstring,
  });
 
  return $lock;
}
 
sub _time_to_string {
  my ($self, $time) = @_;
 
  $time = [ localtime ] unless $time;

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

268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288 ...and a B<warning>.
 
DBIx::Locker was written to replace some lousy database resource locking code.
The code would establish a MySQL lock with C<GET_LOCK> to lock arbitrary
resources.  Unfortunately, the code would also silently reconnect in case of
database connection failure, silently losing the connection-based lock.
DBIx::Locker locks by creating a persistent row in a "locks" table.
 
Because DBIx::Locker locks are stored in a table, they won't go away.  They
have to be purged regularly.  (A program for doing this, F<dbix_locker_purge>,
is included.)  The locked resource is just a string.  All records in the lock
(or semaphore) table are unique on the lock string.
 
This is the I<entire> mechanism.  This is quick and dirty and quite effective,
but it's not highly efficient.  If you need high speed locks with multiple
levels of resolution, or anything other than a quick and brutal solution,
I<keep looking>.
 
=head1 PERL VERSION
 
This library should run on perls released even a long time ago.  It should work

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

349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369 =over
 
=item * C<id> Autoincrementing ID is recommended
 
=item * C<lockstring> varchar(128) with a unique constraint
 
=item * C<created> datetime
 
=item * C<expires> datetime
 
=item * C<locked_by> text
 
=back
 
See the C<sql> directory included in this dist for DDL for your database.
 
=head1 AUTHOR
 
Ricardo SIGNES <cpan@semiotic.systems>
 
=head1 CONTRIBUTORS

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

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66 #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,
    });
  }
}

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

107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164  
  return $new_expiry;
}
 
#pod =method guid
#pod
#pod This method returns the lock's globally unique id.
#pod
#pod =cut
 
sub guid { $_[0]->locked_by->{guid} }
 
#pod =method is_locked
#pod
#pod Method to see if the lock is active or not
#pod
#pod =cut
 
sub is_locked {
   $_[0]->{is_locked} = $_[1] if exists $_[1];
   $_[0]->{is_locked}
}
 
#pod =method unlock
#pod
#pod This method unlocks the lock, deleting the semaphor record.  This method is
#pod automatically called when locks are garbage collected.
#pod
#pod =cut
 
sub unlock {
  my ($self) = @_;
 
  return unless $self->is_locked;
 
  my $dbh   = $self->locker->dbh;
  my $table = $self->locker->table;
 
  my $rows = $dbh->do("DELETE FROM $table WHERE id=?", undef, $self->lock_id);
 
  Carp::confess('error releasing lock') unless $rows == 1;
  $self->is_locked(0);
}
 
sub DESTROY {
  my ($self) = @_;
  local $@;
  return unless $self->locked_by->{pid} == $$;
  $self->unlock;
}
 
1;
 
__END__
 
=pod
 
=encoding UTF-8

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

189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216 L<DBIx::Locker> to create locks.  Since you are not a locker, you should not
call this method.  Seriously.
 
  my $locker = DBIx::Locker::Lock->new(\%arg);
 
This returns a new lock. 
 
  locker     - the locker creating the lock
  lock_id    - the id of the lock in the lock table
  expires    - the time (in epoch seconds) at which the lock will expire
  locked_by  - a hashref of identifying information
  lockstring - the string that was locked
 
=head2 locker
 
=head2 lock_id
 
=head2 locked_by
 
=head2 lockstring
 
These are accessors for data supplied to L</new>.
 
=head2 expires
 
This method returns the expiration time (as a unix timestamp) as provided to
L</new> -- unless expiration has been changed.  Expiration can be changed by
using this method as a mutator:

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

218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237   # expire one hour from now, no matter what initial expiration was
  $lock->expires(time + 3600);
 
When updating the expiration time, if the given expiration time is not a valid
unix time, or if the expiration cannot be updated, an exception will be raised.
 
=head2 guid
 
This method returns the lock's globally unique id.
 
=head2 is_locked
 
Method to see if the lock is active or not
 
=head2 unlock
 
This method unlocks the lock, deleting the semaphor record.  This method is
automatically called when locks are garbage collected.
 
=head1 AUTHOR

sql/mssql.sql view on Meta::CPAN

1
2
3
4
5
6
7
8
9 CREATE TABLE [locks] (
  [id] bigint NOT NULL IDENTITY (1, 1),
  [lockstring] varchar(128) NOT NULL,
  [created] datetime NOT NULL,
  [expires] datetime NOT NULL,
  [locked_by] text NOT NULL,
  CONSTRAINT [PK_locks] PRIMARY KEY CLUSTERED ([id]),
  CONSTRAINT [UC_locks] UNIQUE ([lockstring])
);

sql/mysql.sql view on Meta::CPAN

1
2
3
4
5
6
7 CREATE TABLE semaphores (
  id bigint unsigned NOT NULL PRIMARY KEY AUTO_INCREMENT,
  lockstring varchar(128) UNIQUE,
  created datetime NOT NULL,
  expires datetime NOT NULL,
  locked_by text NOT NULL
);

sql/sqlite.sql view on Meta::CPAN

1
2
3
4
5
6
7 CREATE TABLE locks (
  id INTEGER PRIMARY KEY,
  lockstring varchar(128) UNIQUE,
  created varchar(14) NOT NULL,
  expires varchar(14) NOT NULL,
  locked_by varchar(1024)
);

t/basic.t view on Meta::CPAN

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29  
my @conn = ('dbi:SQLite:dbname=test.db', undef, undef, {});
 
{
  my $dbh = DBI->connect(@conn);
  $dbh->do('CREATE TABLE locks (
    id INTEGER PRIMARY KEY,
    lockstring varchar(128) UNIQUE,
    created varchar(14) NOT NULL,
    expires varchar(14) NOT NULL,
    locked_by varchar(1024)
  )');
}
 
my $locker = DBIx::Locker->new({
  dbi_args => \@conn,
  table    => 'locks',
});
 
isa_ok($locker, 'DBIx::Locker');

t/basic.t view on Meta::CPAN

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66   my $expiry = $lock->expires;
  like($expiry, qr/\A\d+\z/, "expiry is an integer");
  cmp_ok($expiry, '>', time, "expiry is in the future");
 
  $guid = $lock->guid;
 
  eval { $locker->lock('Zombie Soup'); };
  ok(
    $@,
    # (used to be isa_ok) 'X::Unavailable',
    "can't lock already-locked resources"
  );
 
  ok($lock->is_locked, 'lock is active');
  $lock->unlock;
  ok(!$lock->is_locked, 'lock is not active');
  ok(eval { $lock->unlock; 1}, 'unlock twice works');
}
 
{
  my $lock = $locker->lock('Zombie Soup');
  isa_ok($lock, 'DBIx::Locker::Lock', 'newly obtained lock');
 
  isnt($lock->guid, $guid, "new lock guid is not the old lock guid");
 
  my $lock_2 = $locker->lock('Zombie Cola');

( run in 0.560 second using v1.01-cache-2.11-cpan-a9ef4e587e4 )