From 515ac1b2410ff2360bd1f20eef9394b4a2bd82af Mon Sep 17 00:00:00 2001
From: Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
Date: Wed, 6 Oct 2010 18:38:11 +0000
Subject: [PATCH] Added -forced-filename option to the P::C::Document
 contstructor. This allows you to give the Document a filename in situations
 where the Document is being constructed from something that doesn't already
 have a filename (like a reference to a scalar containing actual source code).

---
 lib/Perl/Critic/Document.pm | 22 ++++++++++++++++++----
 t/08_document.t             | 11 ++++++++++-
 2 files changed, 28 insertions(+), 5 deletions(-)

diff --git a/lib/Perl/Critic/Document.pm b/lib/Perl/Critic/Document.pm
index 79ee4d7..a33590c 100644
--- a/lib/Perl/Critic/Document.pm
+++ b/lib/Perl/Critic/Document.pm
@@ -123,6 +123,7 @@ sub _init_from_external_source { ## no critic (Subroutines::RequireArgUnpacking)
     $self->{_doc} = $ppi_document;
     $self->index_locations();
     $self->_disable_shebang_fix();
+    $self->{_forced_filename} = $args{'-forced-filename'};
     $self->{_is_module} = $self->_determine_is_module(\%args);
 
     return;
@@ -253,9 +254,13 @@ sub ppix_regexp_from_element {
 sub filename {
     my ($self) = @_;
 
-    my $doc = $self->{_doc};
-
-    return $doc->can('filename') ? $doc->filename() : undef;
+    if ($self->{_forced_filename}) {
+        return $self->{_forced_filename};
+    }
+    else {
+        my $doc = $self->{_doc};
+        return $doc->can('filename') ? $doc->filename() : undef;
+    }
 }
 
 #-----------------------------------------------------------------------------
@@ -610,13 +615,22 @@ will go through a deprecation cycle.
 
 =over
 
-=item C<< new(-source => $source_code, '-program-extensions' => [program_extensions]) >>
+=item C<< new(-source => $source_code, '-forced-filename' => $filename, '-program-extensions' => [program_extensions]) >>
 
 Create a new instance referencing a PPI::Document instance.  The
 C<$source_code> can be the name of a file, a reference to a scalar
 containing actual source code, or a L<PPI::Document|PPI::Document> or
 L<PPI::Document::File|PPI::Document::File>.
 
+In the event that C<$source_code> is a reference to a scalar containing
+actual source code or a L<PPI::Document|PPI::Document>, the resulting
+L<Perl::Critic::Document|Perl::Critic::Document> will not have a filename.
+This may cause L<Perl::Critic::Document|Perl::Critic::Document> to incorrectly
+classify the source code as a module or script.  To avoid this problem, you
+can optionally set the C<-forced-filename> to force the L<Perl::Critic::Document|Perl::Critic::Document>
+to have a particular C<$filename>.  Do not use this option if C<$source_code>
+is already the name of a file, or is a reference to a L<PPI::Document::File|PPI::Document::File>.
+
 The '-program-extensions' argument is optional, and is a reference to a list
 of strings and/or regular expressions. The strings will be made into regular
 expressions matching the end of a file name, and any document whose file name
diff --git a/t/08_document.t b/t/08_document.t
index c84a5af..10e0186 100644
--- a/t/08_document.t
+++ b/t/08_document.t
@@ -22,7 +22,7 @@ use Perl::Critic::Utils::DataConversion qw< dor >;
 
 
 use Test::Deep;
-use Test::More tests => 41;
+use Test::More tests => 43;
 
 #-----------------------------------------------------------------------------
 
@@ -185,6 +185,15 @@ sub test_version {
 
 #-----------------------------------------------------------------------------
 
+my $nameless_code = 'use strict';
+my $nameless_doc = Perl::Critic::Document->new( -source => \$nameless_code,
+                                                '-forced-filename' => 'Build.PL' );
+
+is($nameless_doc->filename(), 'Build.PL', 'Got forced filename');
+is($nameless_doc->is_module(), 0, 'Forced name affects module determination');
+
+#-----------------------------------------------------------------------------
+
 # ensure we return true if this test is loaded by
 # t/08_document.t_without_optional_dependencies.t
 1;
-- 
1.9.1