File Coverage

blib/lib/PPI/Document/File.pm
Criterion Covered Total %
statement 19 26 73.0
branch 3 8 37.5
condition n/a
subroutine 5 6 83.3
pod 2 2 100.0
total 29 42 69.0


line stmt bran cond sub pod time code
1             package PPI::Document::File;
2              
3             =pod
4              
5             =head1 NAME
6              
7             PPI::Document::File - A Perl Document located in a specific file
8              
9             =head1 DESCRIPTION
10              
11             B
12              
13             B provides a L subclass that represents
14             a Perl document stored in a specific named file.
15              
16             =head1 METHODS
17              
18             =cut
19              
20 63     63   59489 use strict;
  63         119  
  63         1471  
21 63     63   282 use Carp ();
  63         105  
  63         991  
22 63     63   635 use Params::Util qw{_STRING _INSTANCE};
  63         5384  
  63         2446  
23 63     63   806 use PPI::Document ();
  63         120  
  63         12498  
24              
25             our $VERSION = '1.275';
26              
27             our @ISA = 'PPI::Document';
28              
29              
30              
31              
32              
33             #####################################################################
34             # Constructor and Accessors
35              
36             =pod
37              
38             =head2 new
39              
40             my $file = PPI::Document::File->new( 'Module.pm' );
41              
42             The C constructor works the same as for the regular one, except
43             that the only params allowed is a file name. You cannot create an
44             "anonymous" PPI::Document::File object, not can you create an empty one.
45              
46             Returns a new PPI::Document::File object, or C on error.
47              
48             =cut
49              
50             sub new {
51 3     3 1 1337 my $class = shift;
52 3         10 my $filename = _STRING(shift);
53 3 50       10 unless ( defined $filename ) {
54             # Perl::Critic got a complaint about not handling a file
55             # named "0".
56 0         0 return $class->_error("Did not provide a file name to load");
57             }
58              
59             # Load the Document
60 3 50       17 my $self = $class->SUPER::new( $filename, @_ ) or return undef;
61              
62             # Unlike a normal inheritance situation, due to our need to stay
63             # compatible with caching magic, this actually returns a regular
64             # anonymous document. We need to rebless if
65 3 50       21 if ( _INSTANCE($self, 'PPI::Document') ) {
66 3         9 bless $self, 'PPI::Document::File';
67             } else {
68 0         0 die "PPI::Document::File SUPER call returned an object of the wrong type";
69             }
70              
71 3         7 $self;
72             }
73              
74             =pod
75              
76             =head2 save
77              
78             # Save to the file we were loaded from
79             $file->save;
80            
81             # Save a copy to somewhere else
82             $file->save( 'Module2.pm' );
83              
84             The C method works similarly to the one in the parent L
85             class, saving a copy of the document to a file.
86              
87             The difference with this subclass is that if C is not passed any
88             filename, it will save it back to the file it was loaded from.
89              
90             Note: When saving to a different file, it is considered to be saving a
91             B and so the value returned by the C accessor will stay
92             the same, and not change to the new filename.
93              
94             =cut
95              
96             sub save {
97 0     0 1   my $self = shift;
98              
99             # Save to where?
100 0           my $filename = shift;
101 0 0         unless ( defined $filename ) {
102 0           $filename = $self->filename;
103             }
104              
105             # Hand off to main save method
106 0           $self->SUPER::save( $filename, @_ );
107             }
108              
109             1;
110              
111             =pod
112              
113             =head1 TO DO
114              
115             - May need to overload some methods to forcefully prevent Document
116             objects becoming children of another Node.
117              
118             =head1 SUPPORT
119              
120             See the L in the main module.
121              
122             =head1 AUTHOR
123              
124             Adam Kennedy Eadamk@cpan.orgE
125              
126             =head1 COPYRIGHT
127              
128             Copyright 2001 - 2011 Adam Kennedy.
129              
130             This program is free software; you can redistribute
131             it and/or modify it under the same terms as Perl itself.
132              
133             The full text of the license can be found in the
134             LICENSE file included with this module.
135              
136             =cut