File Coverage

blib/lib/Text/Template/Simple/Cache/ID.pm
Criterion Covered Total %
statement 41 44 93.1
branch 7 16 43.7
condition 2 4 50.0
subroutine 11 11 100.0
pod 4 4 100.0
total 65 79 82.2


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