local-lib5/lib/perl5/PPI/Document/File.pm

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