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.59';
7 30     30   227 use strict;
  30         66  
  30         903  
8 30     30   164 use warnings;
  30         62  
  30         815  
9              
10 30     30   164 use File::Basename;
  30         68  
  30         3447  
11 30     30   210 use File::Spec;
  30         85  
  30         737  
12              
13 30     30   16895 use HTML::Mason::Component;
  30         95  
  30         1061  
14 30     30   208 use base qw(HTML::Mason::Component);
  30         67  
  30         5911  
15              
16 30     30   227 use HTML::Mason::Exceptions( abbr => ['error'] );
  30         62  
  30         165  
17              
18 30     30   177 use HTML::Mason::MethodMaker ( read_only => [ qw( path source_file name dir_path ) ] );
  30         60  
  30         160  
19              
20 7     7 1 28 sub is_file_based { 1 }
21 3     3 0 88 sub persistent { 1 }
22             sub source_dir {
23 3     3 1 12 my $dir = dirname($_[0]->source_file);
24 3         19 return File::Spec->canonpath($dir);
25             }
26             sub title {
27 177     177 1 332 my ($self) = @_;
28 177 100       387 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 1434 my ($self, $interp, $source) = @_;
35              
36 607         1753 $self->{source_file} = $source->friendly_name;
37 607         1549 $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         1397 @{$self}{ 'dir_path', 'name'} = $source->comp_path =~ m,^(.*/)?(.*),s;
  607         1983  
46 607 100       3677 $self->{dir_path} =~ s,/$,, unless $self->{dir_path} eq '/';
47              
48 607         2574 $self->SUPER::assign_runtime_properties($interp, $source);
49             }
50              
51             1;
52              
53             __END__