Author: particle
Date: Wed Jan 24 18:09:38 2007
New Revision: 16784
Modified:
trunk/lib/Parrot/Distribution.pm
Log:
[lib]: refactoring Parrot::Distribution.pm -- part 1
~ apply DRY to source and documentation
~ separate object create and initialization to better allow subclass creation
~ memoize where appropriate for efficiency
~ a few doc and whitespace fixes
Modified: trunk/lib/Parrot/Distribution.pm
==============================================================================
--- trunk/lib/Parrot/Distribution.pm (original)
+++ trunk/lib/Parrot/Distribution.pm Wed Jan 24 18:09:38 2007
@@ -41,6 +41,7 @@
use Parrot::Docs::Directory;
use base qw(Parrot::Docs::Directory);
+
=item C<new()>
Searches up the file system tree from the current working directory
@@ -54,393 +55,232 @@
=cut
+## i'm a singleton
my $dist;
+
sub new {
- my $self = shift;
+ my( $class ) = @_;
return $dist if defined $dist;
+ my $self = bless {}, $class;
+ return $self->_initialize;
+}
+
+sub _initialize {
+ my( $self ) = @_;
+
+ my $file = 'README';
my $path = '.';
while ( $self = $self->SUPER::new($path) ) {
- return $dist = $self
- if $self->file_exists_with_name('README')
- and $self->file_with_name('README')->read =~ m/^This is Parrot/os;
+ if (
+ $self->file_exists_with_name($file)
+ and $self->file_with_name($file)->read =~ m/^This is Parrot/os
+ ) {
+ $dist = $self;
+ last;
+ }
$path = $self->parent_path();
}
- die "Failed to find Parrot distribution root\n";
-}
-
-=back
-
-=head2 Instance Methods
-
-=over 4
-
-=item C<c_source_file_directories()>
-
-Returns the directories which contain C source files.
-
-=cut
-
-sub c_source_file_directories {
- my $self = shift;
-
- my %c_source_dirs =
-
- # Make a hash out of the directories of those files
- map { ( ( File::Spec->splitpath($_) )[1] => 1 ) }
-
- # Only look at files ending in .c
- grep { m|\.c$| }
-
- keys %{ ExtUtils::Manifest::maniread( File::Spec->catfile(
$self->path, "MANIFEST" ) ) };
-
- return map $self->directory_with_name($_) => grep { !m|\.svn/$| }
- sort keys %c_source_dirs;
-}
-
-=item C<c_source_file_with_name($name)>
-
-Returns the C source file with the specified name.
-
-=cut
-
-sub c_source_file_with_name {
- my $self = shift;
- my $name = shift || return;
+ # non-object call syntax since $self is undefined
+ _croak( undef, "Failed to find Parrot distribution root\n" )
+ unless $self;
- $name .= '.c' unless $name =~ /\.[Cc]$/o;
-
- foreach my $dir ( $self->c_source_file_directories ) {
- return $dir->file_with_name($name)
- if $dir->file_exists_with_name($name);
+ if( defined $dist ) {
+ $self->_manifest_files( [
+ sort keys %{ ExtUtils::Manifest::maniread(
+ File::Spec->catfile( $self->path, "MANIFEST" )
+ ) },
+ ] );
}
- print 'WARNING: ' . __FILE__ . ':' . __LINE__ . ' File not found:' . $name
. "\n";
-
- return;
-}
-
-=item C<c_source_files()>
-
-Returns a sorted list of the C source files listed within the MANIFEST of
-Parrot. Returns a list of Parrot::IO::File objects.
-
-=cut
-
-sub c_source_files {
- my $self = shift;
-
- my @manifest_files = keys %{ ExtUtils::Manifest::maniread(
- File::Spec->catfile( $self->path, "MANIFEST" ) ) };
-
- my @c_files = sort grep m{\.[cC]$}o, @manifest_files;
-
- return map ($self->file_with_name($_), @c_files);
+ return $self;
}
-=item C<c_header_file_directories()>
-
-Returns the directories which contain C header files.
-
-=cut
-
-# XXX returns what exactly??? The docs need updating here to help with
-# debugging and further development
-
-sub c_header_file_directories {
- my $self = shift;
-
- my %c_header_dirs =
-
- # Make a hash out of the directories of those files
- map { ( ( File::Spec->splitpath($_) )[1] => 1 ) }
-
- # Only look at files ending in .h
- grep { m|\.h$| }
- keys %{ ExtUtils::Manifest::maniread( File::Spec->catfile(
$self->path, "MANIFEST" ) ) };
-
- return map $self->directory_with_name($_) => grep { !m|\.svn/$| }
- sort keys %c_header_dirs;
+sub _croak {
+ my( $self, @message ) = @_;
+ require Carp;
+ Carp::croak(@message);
}
-=item C<c_header_file_with_name($name)>
-Returns the C header file with the specified name.
+BEGIN {
+ my @getter_setters = qw{ _manifest_files };
-=cut
+ for my $method ( @getter_setters ) {
+ no strict 'refs';
-sub c_header_file_with_name {
- my $self = shift;
- my $name = shift || return;
-
- $name .= '.h' unless $name =~ /\.[Hh]$/o;
-
- foreach my $dir ( $self->c_header_file_directories ) {
- return $dir->file_with_name($name)
- if $dir->file_exists_with_name($name);
+ *$method = sub {
+ my $self = shift;
+ unless (@_) {
+ $self->{$method} ||= [];
+ return wantarray
+ ? @{ $self->{$method} }
+ : $self->{$method};
+ }
+ $self->{$method} = shift;
+ return $self;
+ };
}
-
- print 'WARNING: ' . __FILE__ . ':' . __LINE__ . ' File not found:' . $name
. "\n";
-
- return;
}
-=item C<c_header_files()>
-
-Returns a sorted list of the C header files listed within the MANIFEST of
-Parrot. Returns a list of Parrot::IO::File objects.
-=cut
+=back
-sub c_header_files {
- my $self = shift;
+=head2 Instance Methods
- my @manifest_files = keys %{ ExtUtils::Manifest::maniread(
- File::Spec->catfile( $self->path, "MANIFEST" ) ) };
+=over 4
- my @h_files = sort grep m{\.[hH]$}o, @manifest_files;
+=item C<c_source_file_directories()>
- return map ($self->file_with_name($_), @h_files);
-}
+=item C<c_header_file_directories()>
=item C<pmc_source_file_directories()>
-Returns the directories which contain PMC source files.
-
-=cut
-
-sub pmc_source_file_directories {
- my $self = shift;
+=item C<yacc_source_file_directories()>
- my %pmc_source_dirs =
+=item C<lex_source_file_directories()>
- # Make a hash out of the directories of those files
- map { ( ( File::Spec->splitpath($_) )[1] => 1 ) }
+=item C<ops_source_file_directories()>
- # Only look at files ending in .pmc
- grep { m|\.pmc$| }
+Returns the directories which contain source files of the appropriate filetype.
- keys %{ ExtUtils::Manifest::maniread( File::Spec->catfile(
$self->path, "MANIFEST" ) ) };
+=item C<c_source_file_with_name($name)>
- return map $self->directory_with_name($_) => grep { !m|\.svn/$| }
- sort keys %pmc_source_dirs;
-}
+=item C<c_header_file_with_name($name)>
=item C<pmc_source_file_with_name($name)>
-Returns the PMC source file with the specified name.
-
-=cut
-
-sub pmc_source_file_with_name {
- my $self = shift;
- my $name = shift || return;
-
- $name .= '.pmc';
-
- foreach my $dir ( $self->pmc_source_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<pmc_source_files()>
-
-Returns a sorted list of the PMC files listed within the MANIFEST of
-Parrot. Returns a list of Parrot::IO::File objects.
-
-=cut
-
-sub pmc_source_files {
- my $self = shift;
-
- my @manifest_files = keys %{ ExtUtils::Manifest::maniread(
- File::Spec->catfile( $self->path, "MANIFEST" ) ) };
-
- my @pmc_files = sort grep m{\.pmc$}o, @manifest_files;
-
- return map ($self->file_with_name($_), @pmc_files);
-}
-
-=item C<yacc_source_file_directories()>
-
-Returns the directories which contain yacc source files.
-
-=cut
-
-sub yacc_source_file_directories {
- my $self = shift;
-
- return map $self->directory_with_name($_) =>
- 'compilers/imcc/',
- 'languages/cola/',
- 'languages/lua/doc',
- 'languages/regex/lib/Regex',
- ;
-}
-
=item C<yacc_source_file_with_name($name)>
-Returns the yacc source file with the specified name.
-
-=cut
-
-sub yacc_source_file_with_name {
- my $self = shift;
- my $name = shift || return;
-
- $name .= '.y';
-
- foreach my $dir ( $self->yacc_source_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<yacc_source_files()>
-
-Returns a sorted list of the yacc files listed within the MANIFEST of
-Parrot. Returns a list of Parrot::IO::File objects.
-
-=cut
-
-sub yacc_source_files {
- my $self = shift;
-
- my @manifest_files = keys %{ ExtUtils::Manifest::maniread(
- File::Spec->catfile( $self->path, "MANIFEST" ) ) };
-
- my @yacc_files = sort grep m{\.y$}o, @manifest_files;
-
- return map ($self->file_with_name($_), @yacc_files);
-}
-
-=item C<lex_source_file_directories()>
-
-Returns the directories which contain lex source files.
-
-=cut
-
-sub lex_source_file_directories {
- my $self = shift;
-
- return map $self->directory_with_name($_) =>
- 'compilers/imcc/',
- 'languages/cola/',
- ;
-}
-
=item C<lex_source_file_with_name($name)>
-Returns the lex source file with the specified name.
-
-=cut
+=item C<ops_source_file_with_name($name)>
-sub lex_source_file_with_name {
- my $self = shift;
- my $name = shift || return;
+Returns the source file with the specified name and of the appropriate
filetype.
- $name .= '.l';
+=item C<c_source_files()>
- foreach my $dir ( $self->lex_source_file_directories ) {
- return $dir->file_with_name($name)
- if $dir->file_exists_with_name($name);
- }
+=item C<c_header_files()>
- print 'WARNING: ' . __FILE__ . ':' . __LINE__ . ' File not found:' . $name
. "\n";
+=item C<pmc_source_files()>
- return;
-}
+=item C<yacc_source_files()>
=item C<lex_source_files()>
-Returns a sorted list of the lex files listed within the MANIFEST of
-Parrot. Returns a list of Parrot::IO::File objects.
-
-=cut
-
-sub lex_source_files {
- my $self = shift;
-
- my @manifest_files = keys %{ ExtUtils::Manifest::maniread(
- File::Spec->catfile( $self->path, "MANIFEST" ) ) };
-
- my @lex_files = sort grep m{\.l$}o, @manifest_files;
-
- return map ($self->file_with_name($_), @lex_files);
-}
-
-=item C<ops_source_file_directories()>
+=item C<ops_source_files()>
-Returns the directories which contain ops source files.
+Returns a sorted list of the source files listed within the MANIFEST of
+Parrot. Returns a list of Parrot::IO::File objects of the appropriate
filetype.
=cut
-sub ops_source_file_directories {
- my $self = shift;
-
- return map $self->directory_with_name($_) =>
- 'src/ops/',
- 'src/dynoplibs/',
- 'languages/tcl/src/ops/',
- 'languages/WMLScript/ops/',
- 'languages/dotnet/ops/',
- ;
-}
-
-=item C<ops_source_file_with_name($name)>
-
-Returns the ops source file with the specified name.
+BEGIN {
+ my %file_class = (
+ source => {
+ c => { file_exts => ['c'] },
+ pmc => { file_exts => ['pmc'] },
+ ops => { file_exts => ['ops'] },
+ lex => {
+ file_exts => ['l'],
+ except_dirs => [
+ qw{ languages/lisp examples/library }
+ ],
+ },
+ yacc => { file_exts => ['y'] },
+# perl => { file_exts => ['pl', 'pm', 'in', 't'] },
+ },
+ header => {
+ c => { file_exts => ['h'] },
+ },
+ );
-=cut
+ my @ignore_dirs = qw{ .svn };
-sub ops_source_file_with_name {
- my $self = shift;
- my $name = shift || return;
- $name .= '.ops';
-
- foreach my $dir ( $self->ops_source_file_directories ) {
- return $dir->file_with_name($name)
- if $dir->file_exists_with_name($name);
+ for my $class ( keys %file_class ) {
+ for my $type ( keys %{ $file_class{$class} } ) {
+ no strict 'refs';
+
+ my @exts = @{ $file_class{$class}{$type}{file_exts} };
+ my @exceptions = defined $file_class{$class}{$type}{except_dirs}
+ ? @{ $file_class{$class}{$type}{except_dirs} }
+ : ();
+ my $method = join '_' => $type, $class;
+ my $filter_ext = join '|' => map { "\\.${_}\$" } @exts;
+ my $filter_dir = join '|' =>
+ map { qr{\b$_\b} }
+ map { quotemeta($_) }
+ @ignore_dirs,
+ @exceptions;
+
+ next unless $method;
+
+ *{ $method . '_file_directories' } = sub {
+ my $self = shift;
+
+ # Look through the manifest
+ # for files ending in the proper extension(s)
+ # and make a hash out of the directories
+ my %dirs =
+ map { ( ( File::Spec->splitpath($_) )[1] => 1 ) }
+ grep { m|(?i)(?:$filter_ext)| }
+ $self->_manifest_files;
+
+ # Filter out ignored directories
+ # and return the results
+ return
+ sort
+ map { $self->directory_with_name($_) }
+ grep { !m|(?:$filter_dir)| }
+ keys %dirs;
+ };
+
+
+ *{ $method . '_file_with_name' } = sub {
+ my( $self, $name ) = @_;
+ return unless length $name;
+
+ if ( 1 == @exts ) {
+ my $ext = $exts[0];
+ $name .= ".$ext"
+ if $name !~ qr/(?i)\.$ext$/;
+ }
+
+ my $meth = $method . '_file_directories';
+ for my $dir ( $self->$meth ) {
+ return $dir->file_with_name($name)
+ if $dir->file_exists_with_name($name);
+ }
+
+ print 'WARNING: ' . __FILE__ . ':' . __LINE__
+ . ' File not found: ' . $name . "\n";
+ return;
+ };
+
+
+ *{ $method . '_files' } = sub {
+ my( $self ) = @_;
+
+ # Look through the manifest
+ # for files ending in the proper extension(s)
+ # and return a sorted list of filenames
+ return
+ sort
+ map { $self->file_with_name($_) }
+ grep { m|(?i)(?:$filter_ext)| }
+ $self->_manifest_files;
+ };
+ }
}
-
- print 'WARNING: ' . __FILE__ . ':' . __LINE__ . ' File not found:' . $name
. "\n";
-
- return;
}
-=item C<ops_source_files()>
-
-Returns a sorted list of the ops files listed within the MANIFEST of
-Parrot. Returns a list of Parrot::IO::File objects.
-
-=cut
-
-sub ops_source_files {
- my $self = shift;
-
- my @manifest_files = keys %{ ExtUtils::Manifest::maniread(
- File::Spec->catfile( $self->path, "MANIFEST" ) ) };
-
- my @ops_files = sort grep m{\.ops$}o, @manifest_files;
-
- return map ($self->file_with_name($_), @ops_files);
-}
=item C<get_c_language_files()>
@@ -452,7 +292,7 @@
=item C header files C<*.h>
-=item (f)lex files C<*.lex>
+=item (f)lex files C<*.l>
=item yacc/bison files C<*.y>
@@ -490,6 +330,7 @@
# XXX: lex_source_files() collects lisp files as well... how to fix ???
}
+
=item C<is_c_exemption()>
Determines if the given filename is an exemption to being in the C source.
@@ -497,29 +338,26 @@
=cut
-sub is_c_exemption {
- my $self = shift;
- my $file = shift;
+{
+ my @exemptions;
- my @exemptions = qw(
- config/gen/cpu/i386/memcpy_mmx.c
- config/gen/cpu/i386/memcpy_sse.c
- compilers/imcc/imclexer.c
- compilers/imcc/imcparser.c
- compilers/imcc/imcparser.h
- languages/cola/lexer.c
- languages/cola/parser.c
- languages/cola/parser.h
- );
-
- # XXX this is inefficient isn't it?
- foreach my $exemption ( @exemptions ) {
- return 1 if $file->path =~ $exemption;
- }
+ sub is_c_exemption {
+ my( $self, $file ) = @_;
- return 0;
+ push @exemptions => map { File::Spec->canonpath($_) } qw{
+ config/gen/cpu/i386/memcpy_mmx.c config/gen/cpu/i386/memcpy_sse.c
+ compilers/imcc/imclexer.c compilers/imcc/imcparser.c
+ compilers/imcc/imcparser.h languages/cola/lexer.c
+ languages/cola/parser.c languages/cola/parser.h
+ } unless @exemptions;
+
+ $file->path =~ /\Q$_\E$/ && return 1
+ for @exemptions;
+ return;
+ }
}
+
=item C<get_perl_language_files()>
Returns the Perl language source files within Parrot. Namely:
@@ -552,6 +390,7 @@
return @files;
}
+
=item C<is_perl_exemption()>
Determines if the given filename is an exemption to being in the Perl
@@ -560,31 +399,25 @@
=cut
-sub is_perl_exemption {
- my $self = shift;
- my $file = shift;
+{
+ my @exemptions;
- my @exemptions = qw(
- languages/lua/Lua/parser.pm
- languages/regex/lib/Regex/Grammar.pm
- lib/Class/*
- lib/Digest/*
- lib/File/*
- lib/Parse/*
- lib/Pod/*
- lib/SmartLink.pm
- lib/Test/*
- lib/Text/*
- );
-
- # XXX this is inefficient isn't it?
- foreach my $exemption ( @exemptions ) {
- return 1 if $file =~ $exemption;
- }
+ sub is_perl_exemption {
+ my( $self, $file ) = @_;
- return 0;
+ push @exemptions => map { File::Spec->canonpath($_) } qw{
+ languages/lua/Lua/parser.pm languages/regex/lib/Regex/Grammar.pm
+ lib/Class/* lib/Digest/* lib/File/* lib/Parse/*
+ lib/Pod/* lib/SmartLink.pm lib/Test/* lib/Text/*
+ } unless @exemptions;
+
+ $file->path =~ /\Q$_\E$/ && return 1
+ for @exemptions;
+ return;
+ }
}
+
=item C<is_perl()>
Determines if the given filename is Perl source
@@ -615,7 +448,7 @@
# Now let's check to see if there's a perl shebang.
open my $file_handle, '<', $filename
- or die "Could not open $filename for reading";
+ or $self->_croak( "Could not open $filename for reading" );
my $line = <$file_handle>;
close $file_handle;
@@ -626,6 +459,7 @@
return 0;
}
+
=item C<file_for_perl_module($module)>
Returns the Perl module file for the specified module.
@@ -650,6 +484,7 @@
return $dir->existing_file_with_name($module);
}
+
=item C<docs_directory()>
Returns the documentation directory.
@@ -662,6 +497,7 @@
return $self->existing_directory_with_name('docs');
}
+
=item C<html_docs_directory()>
Returns the HTML documentation directory.
@@ -674,6 +510,7 @@
return $self->docs_directory->directory_with_name('html');
}
+
=item C<delete_html_docs()>
Deletes the HTML documentation directory.
@@ -686,6 +523,7 @@
return $self->html_docs_directory->delete();
}
+
=item C<gen_manifest_skip>
Query the svn:ignore property and generate the lines for MANIFEST.SKIP.
@@ -732,6 +570,7 @@
return [EMAIL PROTECTED];
}
+
=item C<generated_files>
Returns a hash where the keys are the files in F<MANIFEST.generated> and the
