File Coverage

lib/Template/Plugin/Datafile.pm
Criterion Covered Total %
statement 34 34 100.0
branch 5 8 62.5
condition 9 10 90.0
subroutine 5 5 100.0
pod 1 2 50.0
total 54 59 91.5


line stmt bran cond sub pod time code
1             #============================================================= -*-Perl-*-
2             #
3             # Template::Plugin::Datafile
4             #
5             # DESCRIPTION
6             # Template Toolkit Plugin which reads a datafile and constructs a
7             # list object containing hashes representing records in the file.
8             #
9             # AUTHOR
10             # Andy Wardley
11             #
12             # COPYRIGHT
13             # Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved.
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::Datafile;
21              
22 1     1   6 use strict;
  1         1  
  1         35  
23 1     1   5 use warnings;
  1         1  
  1         30  
24 1     1   4 use base 'Template::Plugin';
  1         1  
  1         360  
25              
26             our $VERSION = 2.72;
27              
28             sub new {
29 3     3 1 7 my ($class, $context, $filename, $params) = @_;
30 3         4 my ($delim, $line, @fields, @data, @results);
31 3         5 my $self = [ ];
32 3         8 local *FD;
33 3         14 local $/ = "\n";
34              
35 3   100     9 $params ||= { };
36 3   100     11 $delim = $params->{'delim'} || ':';
37 3         8 $delim = quotemeta($delim);
38              
39 3 50       7 return $class->fail("No filename specified")
40             unless $filename;
41              
42 3 50       191 open(FD, $filename)
43             || return $class->fail("$filename: $!");
44              
45             # first line of file should contain field definitions
46 3   100     10 while (! $line || $line =~ /^#/) {
47 6         58 $line = ;
48 6         10 chomp $line;
49 6         37 $line =~ s/\r$//;
50             }
51              
52 3 50       79 (@fields = split(/\s*$delim\s*/, $line))
53             || return $class->fail("first line of file must contain field names");
54              
55             # read each line of the file
56 3         15 while () {
57 10         14 chomp;
58 10         14 s/\r$//;
59              
60             # ignore comments and blank lines
61 10 100 66     66 next if /^#/ || /^\s*$/;
62              
63             # split line into fields
64 9         93 @data = split(/\s*$delim\s*/);
65              
66             # create hash record to represent data
67 9         15 my %record;
68 9         32 @record{ @fields } = @data;
69              
70 9         53 push(@$self, \%record);
71             }
72              
73             # return $self;
74 3         66 bless $self, $class;
75             }
76              
77              
78             sub as_list {
79 2     2 0 6 return $_[0];
80             }
81              
82              
83             1;
84              
85             __END__