File Coverage

blib/lib/IRC/Toolkit/TS6.pm
Criterion Covered Total %
statement 29 32 90.6
branch 5 6 83.3
condition 2 2 100.0
subroutine 9 10 90.0
pod 3 4 75.0
total 48 54 88.8


line stmt bran cond sub pod time code
1             package IRC::Toolkit::TS6;
2             $IRC::Toolkit::TS6::VERSION = '0.092002';
3 1     1   13983 use strictures 2;
  1         1077  
  1         32  
4 1     1   138 use Carp;
  1         1  
  1         63  
5              
6 1     1   348 use parent 'Exporter::Tiny';
  1         250  
  1         3  
7 2     2 1 75400 sub ts6_id { __PACKAGE__->new(@_) }
8             our @EXPORT = our @EXPORT_OK = 'ts6_id';
9              
10             use overload
11 0     0   0 bool => sub { 1 },
12 50000     50000   74524 '&{}' => sub { my $s = shift; sub { $s->next } },
  50000         74515  
  50000         45394  
13 1         8 '""' => 'as_string',
14 1     1   3570 fallback => 1;
  1         736  
15              
16             =pod
17              
18             =for Pod::Coverage new
19              
20             =cut
21              
22 2   100 2 0 22 sub new { bless [ split '', $_[1] || 'A'x6 ], $_[0] }
23              
24 50005     50005 1 28561 sub as_string { join '', @{ $_[0] } }
  50005         127387  
25              
26             sub next {
27 50002     50002 1 31923 my ($self) = @_;
28              
29 50002         35518 my $pos = @$self;
30 50002         60925 while (--$pos) {
31 51433 100       74510 if ($self->[$pos] eq 'Z') {
    100          
32 1428         932 $self->[$pos] = 0;
33 1428         1355 return $self->as_string
34             } elsif ($self->[$pos] ne '9') {
35 48573         28812 $self->[$pos]++;
36 48573         43962 return $self->as_string
37             } else {
38 1432         1892 $self->[$pos] = 'A';
39             }
40             }
41              
42 1 50       167 croak "Ran out of IDs!" if $self->[0] eq 'Z';
43              
44 0           ++$self->[$pos];
45              
46 0           $self->as_string
47             }
48              
49             1;
50              
51             =pod
52              
53             =head1 NAME
54              
55             IRC::Toolkit::TS6 - Generate TS6 IDs
56              
57             =head1 SYNOPSIS
58              
59             use IRC::Toolkit::TS6;
60              
61             my $idgen = ts6_id();
62             my $nextid = $idgen->next;
63              
64             =head1 DESCRIPTION
65              
66             Lightweight array-type objects that can produce sequential TS6 IDs.
67              
68             =head2 ts6_id
69              
70             The exported B function will instance a new ID object. B
71             optionally takes a start-point as a string (defaults to 'AAAAAA' similar to
72             C).
73              
74             The object is overloaded in two ways; it stringifies to the current ID, and
75             calling it as a C ref is the same as calling L:
76              
77             my $idgen = ts6_id;
78             my $current = "$idgen"; # 'AAAAAA'
79             my $next = $idgen->(); # 'AAAAAB'
80              
81             =head2 as_string
82              
83             The C method explicitly stringifies the current ID.
84              
85             =head2 next
86              
87             The C will increment the current ID and return the ID as a string.
88              
89             If no more IDs are available, B will croak.
90              
91             =head1 AUTHOR
92              
93             Jon Portnoy ; conceptually derived from the relevant
94             C function.
95              
96             =cut