lib/IndexData/Utils/PersistentCounter.pm

   1 package IndexData::Utils::PersistentCounter;
   2
   3 use 5.018002;
   4 use strict;
   5 use warnings;
   6
   7 use IO::File;
   8
   9
  10 =head1 NAME
  11
  12 IndexData::Utils::PersistentCounter - Perl extension imnlementing persistent counters
  13
  14 =head1 SYNOPSIS
  15
  16   use IndexData::Utils::PersistentCounter;
  17   $counter = new IndexData::Utils::PersistentCounter($file, 1);
  18   $n = $counter->next();
  19   $n = $counter->next();
  20   # ...
  21   $n = $counter->delete();
  22
  23 =head1 DESCRIPTION
  24
  25 This library provides a simple persistent counter class for
  26 maintaining a counter on disk across multiple runs of a program. It is
  27 safe against multiple concurrent accesses (i.e. will not issue the
  28 same value twice to different processes). It can be used for
  29 applications such as generating unique record IDs.
  30
  31 =head1 METHODS
  32
  33 =head2 new()
  34
  35   $old = new IndexData::Utils::PersistentCounter($file1);
  36   $new = new IndexData::Utils::PersistentCounter($file2, 1);
  37
  38 Creates a new counter object associated with a file which contains the
  39 persistent state of the counter. The purpose of the counter is to
  40 return consecutive integers on consecutive calls, even if those calls
  41 are made from multiple concurrent processes. The file stores the state
  42 across invocations.
  43
  44 In the usual case (no second argument), the file must already exist;
  45 if it does not, it is not created, but an undefined value is returned.
  46
  47 If a second argument is provided and its value is true, then a new
  48 counter file is created with initial value 1. Note that B<this will
  49 overwrite any existing file>, so use with caution.
  50
  51 =cut
  52
  53 sub new {
  54     my $class = shift();
  55     my($file, $create) = @_;
  56
  57     if (! -f $file) {
  58         return undef if !$create;
  59         #   ### There is a bit of a race condition here, but it's not
  60         #       something that's going to crop up in real life.
  61         my $fh = new IO::File(">$file") || return undef;
  62         $fh->print("1\n");
  63         $fh->close() or return undef;
  64     }
  65
  66     my $this = bless {
  67         file => $file,
  68     }, $class;
  69
  70     return $this;
  71 }
  72
  73
  74 =head2 next()
  75
  76   $n = $counter->next();
  77
  78 Returns the next available integer from the specified counter, and
  79 increments the counter ready for the next invocation (whether that
  80 invocation is in this process or a different one).
  81
  82 The first call of C<next()> on a newly created counter returns 1, not
  83 0. Each subsequent call returns a value one higher than the previous
  84 call.
  85
  86 =cut
  87
  88 sub next {
  89     my $this = shift();
  90
  91     my $fh = new IO::File('+<' . $this->{file}) || return undef;
  92     flock($fh, 2) || die "can't lock file";
  93     my $n = <$fh>;
  94     $fh->seek(0, 0);
  95     $fh->print($n+1, "\n");
  96     $fh->close() or return undef;
  97     return $n+0;
  98 }
  99
 100
 101 =head2 delete()
 102
 103   $ok = $counter->delete();
 104
 105 Permanently deletes a counter file. Returns true if the deletion was
 106 successful, false otherwise.
 107
 108 =cut
 109
 110 sub delete {
 111     my $this = shift();
 112
 113     unlink $this->{file} or return 0;
 114     return 1;
 115 }
 116
 117
 118 =head1 SEE ALSO
 119
 120 IndexData::Utils
 121
 122 =head1 AUTHOR
 123
 124 Mike Taylor, E<lt>mike@indexdata.comE<gt>
 125
 126 =head1 COPYRIGHT AND LICENSE
 127
 128 Copyright (C) 2014 by Index Data.
 129
 130 This library is free software; you can redistribute it and/or modify
 131 it under the same terms as Perl itself, either Perl version 5.8.4 or,
 132 at your option, any later version of Perl 5 you may have available.
 133
 134
 135 =cut
 136
 137 1;