File Coverage

blib/lib/HTML/Mason/Component/FileBased.pm
Criterion Covered Total %
statement 37 37 100.0
branch 4 4 100.0
condition n/a
subroutine 13 13 100.0
pod 3 5 60.0
total 57 59 96.6


line stmt bran cond sub pod time code
1             # Copyright (c) 1998-2005 by Jonathan Swartz. All rights reserved.
2             # This program is free software; you can redistribute it and/or modify
3             # it under the same terms as Perl itself.
4              
5             package HTML::Mason::Component::FileBased;
6             $HTML::Mason::Component::FileBased::VERSION = '1.60';
7 30     30   262 use strict;
  30         90  
  30         944  
8 30     30   157 use warnings;
  30         78  
  30         875  
9              
10 30     30   212 use File::Basename;
  30         73  
  30         3423  
11 30     30   222 use File::Spec;
  30         67  
  30         673  
12              
13 30     30   16624 use HTML::Mason::Component;
  30         88  
  30         1068  
14 30     30   203 use base qw(HTML::Mason::Component);
  30         81  
  30         6019  
15              
16 30     30   257 use HTML::Mason::Exceptions( abbr => ['error'] );
  30         74  
  30         164  
17              
18 30     30   232 use HTML::Mason::MethodMaker ( read_only => [ qw( path source_file name dir_path ) ] );
  30         69  
  30         195  
19              
20 7     7 1 28 sub is_file_based { 1 }
21 3     3 0 90 sub persistent { 1 }
22             sub source_dir {
23 3     3 1 10 my $dir = dirname($_[0]->source_file);
24 3         31 return File::Spec->canonpath($dir);
25             }
26             sub title {
27 177     177 1 388 my ($self) = @_;
28 177 100       399 return $self->path . ($self->{source_root_key} ? " [".lc($self->{source_root_key})."]" : "");
29             #return $self->path . ($self->{source_root_key} ? " [$self->{source_root_key}]" : "");
30             }
31              
32             # Ends up setting $self->{path, source_root_key, source_file} and a few in the parent class
33             sub assign_runtime_properties {
34 607     607 0 1446 my ($self, $interp, $source) = @_;
35              
36 607         1799 $self->{source_file} = $source->friendly_name;
37 607         1590 $self->{source_root_key} = $source->extra->{comp_root};
38              
39             # We used to use File::Basename for this but that is broken
40             # because URL paths always use '/' as the dir-separator but we
41             # could be running on any OS.
42             #
43             # The regex itself is taken from File::Basename.
44             #
45 607         1448 @{$self}{ 'dir_path', 'name'} = $source->comp_path =~ m,^(.*/)?(.*),s;
  607         2049  
46 607 100       3851 $self->{dir_path} =~ s,/$,, unless $self->{dir_path} eq '/';
47              
48 607         2626 $self->SUPER::assign_runtime_properties($interp, $source);
49             }
50              
51             1;
52              
53             __END__