File Coverage

lib/Template/Plugin/Directory.pm
Criterion Covered Total %
statement 67 67 100.0
branch 16 20 80.0
condition 7 8 87.5
subroutine 12 12 100.0
pod 1 6 16.6
total 103 113 91.1


line stmt bran cond sub pod time code
1             #============================================================= -*-Perl-*-
2             #
3             # Template::Plugin::Directory
4             #
5             # DESCRIPTION
6             # Plugin for encapsulating information about a file system directory.
7             #
8             # AUTHORS
9             # Michael Stevens , with some mutilations from
10             # Andy Wardley .
11             #
12             # COPYRIGHT
13             # Copyright (C) 2000-2007 Michael Stevens, Andy Wardley.
14             #
15             # This module is free software; you can redistribute it and/or
16             # modify it under the same terms as Perl itself.
17             #
18             #============================================================================
19              
20             package Template::Plugin::Directory;
21              
22 1     1   6 use strict;
  1         2  
  1         35  
23 1     1   6 use warnings;
  1         2  
  1         33  
24 1     1   5 use Cwd;
  1         1  
  1         70  
25 1     1   5 use File::Spec;
  1         1  
  1         22  
26 1     1   408 use Template::Plugin::File;
  1         2  
  1         27  
27 1     1   6 use base 'Template::Plugin::File';
  1         2  
  1         846  
28              
29             our $VERSION = 2.70;
30              
31              
32             #------------------------------------------------------------------------
33             # new(\%config)
34             #
35             # Constructor method.
36             #------------------------------------------------------------------------
37              
38             sub new {
39 36 100   36 1 106 my $config = ref($_[-1]) eq 'HASH' ? pop(@_) : { };
40 36         55 my ($class, $context, $path) = @_;
41              
42 36 100 66     166 return $class->throw('no directory specified')
43             unless defined $path and length $path;
44              
45 35         149 my $self = $class->SUPER::new($context, $path, $config);
46 34         53 my ($dir, @files, $name, $item, $abs, $rel, $check);
47 34         94 $self->{ files } = [ ];
48 34         69 $self->{ dirs } = [ ];
49 34         67 $self->{ list } = [ ];
50 34         61 $self->{ _dir } = { };
51              
52             # don't read directory if 'nostat' or 'noscan' set
53 34 100 100     194 return $self if $config->{ nostat } || $config->{ noscan };
54              
55             $self->throw("$path: not a directory")
56 19 50       59 unless $self->{ isdir };
57              
58 19         67 $self->scan($config);
59              
60 19         78 return $self;
61             }
62              
63              
64             #------------------------------------------------------------------------
65             # scan(\%config)
66             #
67             # Scan directory for files and sub-directories.
68             #------------------------------------------------------------------------
69              
70             sub scan {
71 23     23 0 207 my ($self, $config) = @_;
72 23   100     54 $config ||= { };
73 23         52 local *DH;
74 23         27 my ($dir, @files, $name, $abs, $rel, $item);
75            
76             # set 'noscan' in config if recurse isn't set, to ensure Directories
77             # created don't try to scan deeper
78 23 100       73 $config->{ noscan } = 1 unless $config->{ recurse };
79              
80 23         42 $dir = $self->{ abs };
81 23 50       644 opendir(DH, $dir) or return $self->throw("$dir: $!");
82              
83 23         399 @files = readdir DH;
84 23 50       245 closedir(DH)
85             or return $self->throw("$dir close: $!");
86              
87 23         66 my ($path, $files, $dirs, $list) = @$self{ qw( path files dirs list ) };
88 23         54 @$files = @$dirs = @$list = ();
89              
90 23         113 foreach $name (sort @files) {
91 125 100       349 next if $name =~ /^\./;
92 79         765 $abs = File::Spec->catfile($dir, $name);
93 79         610 $rel = File::Spec->catfile($path, $name);
94              
95 79 100       1330 if (-d $abs) {
96 22         105 $item = Template::Plugin::Directory->new(undef, $rel, $config);
97 22         44 push(@$dirs, $item);
98             }
99             else {
100 57         241 $item = Template::Plugin::File->new(undef, $rel, $config);
101 57         137 push(@$files, $item);
102             }
103 79         110 push(@$list, $item);
104 79         282 $self->{ _dir }->{ $name } = $item;
105             }
106              
107 23         110 return '';
108             }
109              
110              
111             #------------------------------------------------------------------------
112             # file($filename)
113             #
114             # Fetch a named file from this directory.
115             #------------------------------------------------------------------------
116              
117             sub file {
118 1     1 0 4 my ($self, $name) = @_;
119 1         12 return $self->{ _dir }->{ $name };
120             }
121              
122              
123             #------------------------------------------------------------------------
124             # present($view)
125             #
126             # Present self to a Template::View
127             #------------------------------------------------------------------------
128              
129             sub present {
130 3     3 0 5 my ($self, $view) = @_;
131 3         19 $view->view_directory($self);
132             }
133              
134              
135             #------------------------------------------------------------------------
136             # content($view)
137             #
138             # Present directory content to a Template::View.
139             #------------------------------------------------------------------------
140              
141             sub content {
142 3     3 0 68 my ($self, $view) = @_;
143 3 50       8 return $self->{ list } unless $view;
144 3         4 my $output = '';
145 3         4 foreach my $file (@{ $self->{ list } }) {
  3         8  
146 9         25 $output .= $file->present($view);
147             }
148 3         14 return $output;
149             }
150              
151              
152             #------------------------------------------------------------------------
153             # throw($msg)
154             #
155             # Throw a 'Directory' exception.
156             #------------------------------------------------------------------------
157              
158             sub throw {
159 2     2 0 4 my ($self, $error) = @_;
160 2         15 die (Template::Exception->new('Directory', $error));
161             }
162              
163             1;
164              
165             __END__