# New Ticket Created by "Paul Cochrane"
# Please include the string: [perl #40428]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=40428 >
Hi,
This is a patch to return the names and locations of the perl script
and module files within the parrot distribution. The patch adds
subroutines to lib/Parrot/Distribution.pm that parallel the behaviour
of similar subroutines which return the locations of the C source and
header files. This functionality can then be used for testing the
perl coda. Btw: the solution feels untidy and difficult to maintain
somehow, as I just copied the structure from the C-related
subroutines; any feedback on how to refactor the code into a more
maintainable form would be much appreciated. That said, it does the
job though ;-)
Regards,
Paul
files affected:
lib/Parrot/Distribution.pm
Index: lib/Parrot/Distribution.pm
===================================================================
--- lib/Parrot/Distribution.pm (revision 14786)
+++ lib/Parrot/Distribution.pm (working copy)
@@ -214,6 +214,150 @@
}
+=item C<perl_script_file_directories()>
+
+Returns the directories which contain perl source files.
+
+(but misses Configure.pl...)
+
+=cut
+
+sub perl_script_file_directories
+{
+ my $self = shift;
+
+ return
+ map $self->directory_with_name($_) =>
+ 'compilers/imcc',
+ 'editor',
+ 'examples/benchmarks', 'examples/mops',
+ 'languages',
+ map("languages/$_" => qw<
+ APL/tools
+ BASIC/compiler BASIC/interpreter
+ WMLScript/build
+ dotnet dotnet/build dotnet/tools
+ lua
+ m4/tools
+ plumhead
+ python
+ regex
+ scheme scheme/Scheme
+ tcl/tools
+ urm
+ >
+ ),
+ map("tools/$_" => qw<build dev docs util>),
+ ;
+}
+
+=item C<perl_script_file_with_name($name)>
+
+Returns the perl script with the specified name.
+
+=cut
+
+sub perl_script_file_with_name
+{
+ my $self = shift;
+ my $name = shift || return;
+
+ $name .= '.pl' unless $name =~ /\.pl$/o;
+
+ foreach my $dir ($self->perl_script_file_directories)
+ {
+ return $dir->file_with_name($name)
+ if $dir->file_exists_with_name($name);
+ }
+
+ print 'WARNING: ' . __FILE__ . ':' . __LINE__ . ' File not found:' . $name ."\n";
+
+ return;
+}
+
+
+=item C<perl_module_file_directories()>
+
+Returns the directories which contain perl module files.
+
+=cut
+
+sub perl_module_file_directories
+{
+ my $self = shift;
+
+ return
+ map $self->directory_with_name($_) =>
+ map("config/$_" => qw<auto auto/cpu/i386 auto/cpu/ppc
+ auto/cpu/sun4 auto/cpu/x86_64
+ gen gen/cpu/i386 gen/cpu/x86_64 init init/hints inter>),
+ 'ext/Parrot-Embed/lib/Parrot',
+ map("languages/$_" => qw<
+ APL/t
+ BASIC/compiler
+ HQ9plus/lib/Parrot/Test
+ WMLScript/build/SRM WMLScript/t/Parrot/Test
+ bc/lib/Parrot/Test bc/lib/Parrot/Test/Bc
+ dotnet/build/SRM dotnet/t
+ jako/lib/Jako
+ jako/lib/Jako/Construct
+ lua/Lua lua/t/Parrot/Test
+ m4/lib/Parrot/Test m4/lib/Parrot/Test/M4
+ parrot_compiler/lib/Parrot/Test
+ perl6/t/01-sanity
+ plumhead/lib/Parrot/Test plumhead/lib/Parrot/Test/Plumhead
+ pugs/t
+ regex/lib
+ scheme scheme/Scheme
+ tcl/lib/Parrot/Test
+ urm/lib/URM
+ >
+ ),
+ map("languages/jako/lib/Jako/Construct/$_" => qw<
+ Block Block/Conditional Block/Loop Declaration
+ Expression Expression/Value Statement Type
+ >
+ ),
+ map("languages/regex/lib/$_" => qw<
+ Parrot/Test Regex Regex/CodeGen Regex/Ops Regex/Parse
+ >
+ ),
+ map("lib/$_" => qw<
+ Class Digest/Perl File Parrot Parse Pod Pod/Simple Test Text
+ >
+ ),
+ map("lib/Parrot/$_" => qw<
+ Config Configure Configure/Step Docs Docs/Section IO
+ OpLib OpTrans PIR Pmc2c Test
+ >
+ ),
+ ;
+}
+
+=item C<perl_module_file_with_name($name)>
+
+Returns the perl module file with the specified name.
+
+=cut
+
+sub perl_module_file_with_name
+{
+ my $self = shift;
+ my $name = shift || return;
+
+ $name .= '.pm' unless $name =~ /\.pm$/o;
+
+ foreach my $dir ($self->perl_module_file_directories)
+ {
+ return $dir->file_with_name($name)
+ if $dir->file_exists_with_name($name);
+ }
+
+ print 'WARNING: ' . __FILE__ . ':' . __LINE__ . ' File not found:' . $name ."\n";
+
+ return;
+}
+
=item C<docs_directory()>
Returns the documentation directory.
