File Coverage

blib/lib/XAO/Templates.pm
Criterion Covered Total %
statement 52 83 62.6
branch 22 56 39.2
condition 10 30 33.3
subroutine 7 9 77.7
pod 2 4 50.0
total 93 182 51.1


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             XAO::Templates - templates caching and retrieving module
4              
5             =head1 DESCRIPTION
6              
7             Templates retriever. Uses persistent cache to store once retrieved
8             templates.
9              
10             =over
11              
12             =cut
13              
14             ###############################################################################
15             package XAO::Templates;
16 22     22   1112 use strict;
  22         56  
  22         762  
17 22     22   502 use XAO::Base qw($homedir $projectsdir);
  22         6621  
  22         1999  
18 22     22   635 use XAO::Utils;
  22         17853  
  22         1253  
19 22     22   606 use XAO::Projects qw(get_current_project_name);
  22         1385  
  22         1601  
20              
21             our $VERSION='2.001';
22              
23             # Cache for templates.
24             #
25 22     22   150 use vars qw(%cache);
  22         68  
  22         20669  
26              
27             # Getting the text of given template.
28             #
29             sub get (%) {
30 40     40 0 295 my %args=@_;
31 40         103 my $path=$args{path};
32              
33 40         105 my $sitename=get_current_project_name();
34              
35 40 50       252 if($path =~ /\.\.\//) {
36 0         0 eprint "Bad template path -- sitename=",$sitename,", path=$path";
37 0         0 return undef;
38             }
39              
40             ##
41             # Checking in the memory cache. If there is a record, but it's
42             # 'undef' then the template does not exist in that site's local
43             # tree.
44             #
45 40 50 66     329 if(!defined $sitename) {
    100          
46 0 0 0     0 return $cache{'/'}->{$path} if exists($cache{'/'}) && exists($cache{'/'}->{$path});
47             }
48             elsif(exists $cache{$sitename} && exists $cache{$sitename}->{$path}) {
49 7         30 my $template=$cache{$sitename}->{$path};
50 7 100       34 return $template if defined $template;
51              
52             ##
53             # Otherwise we know we already tried, but failed and it's safe
54             # to return the one from the system cache.
55             #
56 1 50 33     14 return $cache{'/'}->{$path} if exists($cache{'/'}) && exists($cache{'/'}->{$path});
57             }
58              
59             ##
60             # Retrieving from disk. We only get here if cache was a miss.
61             #
62 33         88 my $system;
63             my $tpath;
64 33 50       87 if(defined $sitename) {
65 33         135 $tpath="$projectsdir/$sitename/templates/$path";
66 33         106 $system=0;
67             }
68 33 100 66     1226 if(! $tpath || ! -r $tpath) {
69 16         80 $tpath="$homedir/templates/$path";
70 16         36 $system=1;
71             }
72 33         214 local *F;
73 33         81 my $text;
74 33 50       1680 if(open(F,$tpath)) {
75 33         238 local $/;
76 33         1457 $text=;
77 33         590 close(F);
78             }
79              
80             ##
81             # Storing into cache.
82             #
83 33 50       278 if(!defined $text) {
    50          
84 0         0 $cache{'/'}->{$path}=undef;
85 0 0       0 $cache{$sitename}->{$path}=undef if defined $sitename;
86             }
87             elsif(length($text) < 100000) {
88 33 100       85 if($system) {
89 16         106 $cache{'/'}->{$path}=$text;
90 16 50       76 $cache{$sitename}->{$path}=undef if defined $sitename;
91             }
92             else {
93 17         118 $cache{$sitename}->{$path}=$text;
94             }
95             }
96              
97 33         202 return $text;
98             }
99              
100             ###############################################################################
101              
102             =item filename ($;$)
103              
104             Checks if given path (first argument) exists and returns template's
105             filename if it does and 'undef' if there is no template. Optional second
106             argument refers to a sitename (project name), by default the current
107             active project name is used.
108              
109             =cut
110              
111             sub filename ($;$) {
112 81     81 1 156 my ($path,$sitename)=@_;
113              
114 81   33     301 $sitename||=get_current_project_name();
115              
116 81 50       443 if($path =~ /\.\.\//) {
117 0         0 eprint "Bad template path -- sitename=",$sitename,", path=$path";
118 0         0 return 0;
119             }
120              
121 81 50 33     288 return undef if !defined($path) || $path eq '';
122              
123 81 50       156 if(defined $sitename) {
124 81         174 my $tn="$projectsdir/$sitename/templates/$path";
125 81 100 66     2431 return $tn if -f $tn && -r _;
126             }
127              
128 1         16 my $tn="$homedir/templates/$path";
129 1 50 33     42 return $tn if -f $tn && -r _;
130              
131 1         10 return undef;
132             }
133              
134             ###############################################################################
135              
136             =item check (%)
137              
138             Deprecated method, do not use.
139              
140             =cut
141              
142             sub check (%) {
143 0     0 1   my %args=@_;
144 0           dprint "XAO::Templates::check - deprecated, use filename() instead";
145 0 0         return filename($args{path}) ? 1 : 0;
146             }
147              
148             ###############################################################################
149              
150             # Complete list of all available templates in random order.
151             #
152             # Returns list in array context and array reference in scalar context.
153              
154             sub list (%) {
155 0     0 0   eprint "XAO::Templates::list - is not supported any more";
156 0           my %args=@_;
157 0           my $tpath;
158 0           my $sitename=get_current_project_name();
159 0 0         if(defined $sitename) {
160 0           $tpath="$projectsdir/$sitename/templates/";
161             }
162 0 0 0       if(! $tpath || ! -r $tpath) {
163 0           $tpath="$homedir/templates/";
164             }
165 0 0 0       if(! $tpath || ! -r $tpath) {
166 0           eprint "Templates::list - can't get list";
167 0 0         return wantarray ? () : undef;
168             }
169 0           local *F;
170 0 0         if(!open(F,"/usr/bin/find $tpath -type f |")) {
171 0           eprint "Templates::list - can't get list: $!\n";
172 0 0         return wantarray ? () : undef;
173             }
174 0           my @list=map { chomp; s/^$tpath//; $_ } ;
  0            
  0            
  0            
175 0           close(F);
176 0 0         wantarray ? @list : (@list ? \@list : undef);
    0          
177             }
178              
179             ###############################################################################
180             1;
181             __END__