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.58'; |
7
|
30
|
|
|
30
|
|
197
|
use strict; |
|
30
|
|
|
|
|
85
|
|
|
30
|
|
|
|
|
822
|
|
8
|
30
|
|
|
30
|
|
144
|
use warnings; |
|
30
|
|
|
|
|
60
|
|
|
30
|
|
|
|
|
794
|
|
9
|
|
|
|
|
|
|
|
10
|
30
|
|
|
30
|
|
154
|
use File::Basename; |
|
30
|
|
|
|
|
59
|
|
|
30
|
|
|
|
|
1992
|
|
11
|
30
|
|
|
30
|
|
178
|
use File::Spec; |
|
30
|
|
|
|
|
59
|
|
|
30
|
|
|
|
|
615
|
|
12
|
|
|
|
|
|
|
|
13
|
30
|
|
|
30
|
|
10077
|
use HTML::Mason::Component; |
|
30
|
|
|
|
|
78
|
|
|
30
|
|
|
|
|
1026
|
|
14
|
30
|
|
|
30
|
|
204
|
use base qw(HTML::Mason::Component); |
|
30
|
|
|
|
|
64
|
|
|
30
|
|
|
|
|
4257
|
|
15
|
|
|
|
|
|
|
|
16
|
30
|
|
|
30
|
|
191
|
use HTML::Mason::Exceptions( abbr => ['error'] ); |
|
30
|
|
|
|
|
62
|
|
|
30
|
|
|
|
|
179
|
|
17
|
|
|
|
|
|
|
|
18
|
30
|
|
|
30
|
|
165
|
use HTML::Mason::MethodMaker ( read_only => [ qw( path source_file name dir_path ) ] ); |
|
30
|
|
|
|
|
69
|
|
|
30
|
|
|
|
|
156
|
|
19
|
|
|
|
|
|
|
|
20
|
7
|
|
|
7
|
1
|
68
|
sub is_file_based { 1 } |
21
|
3
|
|
|
3
|
0
|
89
|
sub persistent { 1 } |
22
|
|
|
|
|
|
|
sub source_dir { |
23
|
3
|
|
|
3
|
1
|
19
|
my $dir = dirname($_[0]->source_file); |
24
|
3
|
|
|
|
|
29
|
return File::Spec->canonpath($dir); |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
sub title { |
27
|
177
|
|
|
177
|
1
|
334
|
my ($self) = @_; |
28
|
177
|
100
|
|
|
|
348
|
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
|
1600
|
my ($self, $interp, $source) = @_; |
35
|
|
|
|
|
|
|
|
36
|
607
|
|
|
|
|
2009
|
$self->{source_file} = $source->friendly_name; |
37
|
607
|
|
|
|
|
1741
|
$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
|
|
|
|
|
1934
|
@{$self}{ 'dir_path', 'name'} = $source->comp_path =~ m,^(.*/)?(.*),s; |
|
607
|
|
|
|
|
2091
|
|
46
|
607
|
100
|
|
|
|
4089
|
$self->{dir_path} =~ s,/$,, unless $self->{dir_path} eq '/'; |
47
|
|
|
|
|
|
|
|
48
|
607
|
|
|
|
|
2663
|
$self->SUPER::assign_runtime_properties($interp, $source); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
1; |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
__END__ |