File Coverage

blib/lib/Text/Template/Simple/Cache/ID.pm
Criterion Covered Total %
statement 41 43 95.3
branch 7 16 43.7
condition 2 4 50.0
subroutine 11 11 100.0
pod 4 4 100.0
total 65 78 83.3


line stmt bran cond sub pod time code
1             package Text::Template::Simple::Cache::ID;
2 62     62   363 use strict;
  62         124  
  62         2969  
3 62     62   421 use warnings;
  62         131  
  62         2598  
4 62     62   191434 use overload q{""} => 'get';
  62         89830  
  62         500  
5              
6 62     62   6258 use Text::Template::Simple::Constants qw( MAX_FL RE_INVALID_CID );
  62         135  
  62         5013  
7 62     62   595 use Text::Template::Simple::Util qw( LOG DEBUG DIGEST fatal );
  62         168  
  62         67022  
8              
9             our $VERSION = '0.86';
10              
11             sub new {
12 42     42 1 126 my $class = shift;
13 42         119 my $self = bless do { \my $anon }, $class;
  42         174  
14 42         229 return $self;
15             }
16              
17             sub get {
18 126     126 1 606 my $self = shift;
19 126         147 return ${$self};
  126         462  
20             }
21              
22             sub set { ## no critic (ProhibitAmbiguousNames)
23 42     42 1 979 my $self = shift;
24 42         76 my $val = shift;
25 42 50       131 ${$self} = $val if defined $val;
  42         2149  
26 42         115 return;
27             }
28              
29             sub generate { # cache id generator
30 42     42 1 99 my($self, $data, $custom, $regex) = @_;
31              
32 42 50       230 if ( ! $data ) {
33 0 0       0 fatal('tts.cache.id.generate.data') if ! defined $data;
34 0 0       0 LOG( IDGEN => 'Generating ID from empty data' ) if DEBUG;
35             }
36              
37             $self->set(
38 42 100       232 $custom ? $self->_custom( $data, $regex )
39             : $self->DIGEST->add( $data )->hexdigest
40             );
41              
42 42         154 return $self->get;
43             }
44              
45             sub _custom {
46 16     16   30 my $self = shift;
47 16 50       47 my $data = shift or fatal('tts.cache.id._custom.data');
48 16   50     124 my $regex = shift || RE_INVALID_CID;
49 16         92 $data =~ s{$regex}{_}xmsg; # remove bogus characters
50 16         37 my $len = length $data;
51             # limit file name length
52 16 50       57 $data = substr $data, $len - MAX_FL, MAX_FL if $len > MAX_FL;
53 16         59 return $data;
54             }
55              
56             sub DESTROY {
57 42   50 42   140 my $self = shift || return;
58 42 50       163 LOG( DESTROY => ref $self ) if DEBUG;
59 42         284 return;
60             }
61              
62             1;
63              
64             __END__
65              
66             =head1 NAME
67              
68             Text::Template::Simple::Cache::ID - Cache ID generator
69              
70             =head1 SYNOPSIS
71              
72             TODO
73              
74             =head1 DESCRIPTION
75              
76             This document describes version C<0.86> of C<Text::Template::Simple::Cache::ID>
77             released on C<5 March 2012>.
78              
79             TODO
80              
81             =head1 METHODS
82              
83             =head2 new
84              
85             Constructor
86              
87             =head2 generate DATA [, CUSTOM, INVALID_CHARS_REGEX ]
88              
89             Generates an unique cache id for the supplied data.
90              
91             =head2 get
92              
93             Returns the generated cache ID.
94              
95             =head2 set
96              
97             Set the cache ID.
98              
99             =head1 AUTHOR
100              
101             Burak Gursoy <burak@cpan.org>.
102              
103             =head1 COPYRIGHT
104              
105             Copyright 2004 - 2012 Burak Gursoy. All rights reserved.
106              
107             =head1 LICENSE
108              
109             This library is free software; you can redistribute it and/or modify
110             it under the same terms as Perl itself, either Perl version 5.12.3 or,
111             at your option, any later version of Perl 5 you may have available.
112              
113             =cut