Skip to content
Browse files

working on the plugin framework

  • Loading branch information...
1 parent c2b7a9a commit eb3f7bd0f533f18aa41f68ac59d74fa74d7b7786 petdance committed Aug 20, 2008
Showing with 430 additions and 133 deletions.
  1. +5 −4 Ack.pm
  2. +240 −0 Basic.pm
  3. +7 −4 Makefile.PL
  4. +25 −8 Plugin.pm
  5. +16 −16 Repository.pm
  6. +17 −77 Resource.pm
  7. +2 −0 Tar.pm
  8. +3 −1 ack
  9. +106 −17 ack-standalone
  10. +9 −6 t/standalone.t
View
9 Ack.pm
@@ -5,7 +5,7 @@ use strict;
use File::Next 0.40;
-use App::Ack::Repository;
+use App::Ack::Plugin::Basic;
=head1 NAME
@@ -995,7 +995,7 @@ sub search_resource {
my $before_starts_at_line;
my $after = 0; # number of lines still to print after a match
- while ( $res->next_text() ) {
+ while ( $res->next_text ) {
# XXX Optimize away the case when there are no more @lines to find.
# XXX $has_lines, $passthru and $v never change. Optimize.
if ( $has_lines
@@ -1230,7 +1230,7 @@ sub print_files_with_matches {
my $nmatches = 0;
while ( defined ( my $filename = $iter->() ) ) {
- my $repo = App::Ack::Repository->new( $filename );
+ my $repo = App::Ack::Repository::Basic->new( $filename );
my $res;
while ( $res = $repo->next_resource() ) {
$nmatches += search_and_list( $res, $opt );
@@ -1260,11 +1260,12 @@ sub print_matches {
while ( defined ( my $filename = $iter->() ) ) {
my $repo;
if ( $filename =~ /\.tar\.gz$/ ) {
+ App::Ack::die( 'Not working here yet' );
require App::Ack::Repository::Tar; # XXX Error checking
$repo = App::Ack::Repository::Tar->new( $filename );
}
else {
- $repo = App::Ack::Repository->new( $filename );
+ $repo = App::Ack::Repository::Basic->new( $filename );
}
$repo or next;
View
240 Basic.pm
@@ -0,0 +1,240 @@
+package App::Ack::Plugin::Basic;
+
+=head1 SYNOPSIS
+
+Container for the Repository and Resources necessary.
+
+=cut
+
+
+package App::Ack::Resource::Basic;
+
+=head1 App::Ack::Resource::Basic
+
+=cut
+
+use App::Ack;
+use App::Ack::Resource;
+
+our @ISA = qw( App::Ack::Resource );
+
+use warnings;
+use strict;
+
+=head1 METHODS
+
+=head2 new( $filename )
+
+Opens the file specified by I<$filename> and returns a filehandle and
+a flag that says whether it could be binary.
+
+If there's a failure, it throws a warning and returns an empty list.
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $filename = shift;
+
+ my $self = bless {
+ filename => $filename,
+ fh => undef,
+ could_be_binary => undef,
+ opened => undef,
+ id => undef,
+ }, $class;
+
+ if ( $self->{filename} eq '-' ) {
+ $self->{fh} = *STDIN;
+ $self->{could_be_binary} = 0;
+ }
+ else {
+ if ( !open( $self->{fh}, '<', $self->{filename} ) ) {
+ App::Ack::warn( "$self->{filename}: $!" );
+ return;
+ }
+ $self->{could_be_binary} = 1;
+ }
+
+ return $self;
+}
+
+=head2 $res->name()
+
+Returns the name of the resource.
+
+=cut
+
+sub name {
+ my $self = shift;
+
+ return $self->{filename};
+}
+
+=head2 $res->is_binary()
+
+Tells whether the resource is binary. If it is, and ack finds a
+match in the file, then ack will not try to display a match line.
+
+=cut
+
+sub is_binary() {
+ my $self = shift;
+
+ if ( $self->{could_be_binary} ) {
+ return -B $self->{filename};
+ }
+
+ return 0;
+}
+
+
+=head2 $res->needs_line_scan( \%opts )
+
+API: Tells if the resource needs a line-by-line scan. This is a big
+optimization because if you can tell from the outset that the pattern
+is not found in the resource at all, then there's no need to do the
+line-by-line iteration. If in doubt, return true.
+
+Base: Slurp up an entire file up to 100K, see if there are any
+matches in it, and if so, let us know so we can iterate over it
+directly. If it's bigger than 100K or the match is inverted, we
+have to do the line-by-line, too.
+
+=cut
+
+sub needs_line_scan {
+ my $self = shift;
+ my $opt = shift;
+
+ return 1 if $opt->{v};
+
+ my $size = -s $self->{fh};
+ if ( $size == 0 ) {
+ return 0;
+ }
+ elsif ( $size > 100_000 ) {
+ return 1;
+ }
+
+ my $buffer;
+ my $rc = sysread( $self->{fh}, $buffer, $size );
+ if ( not defined $rc ) {
+ App::Ack::warn( "$self->{filename}: $!" );
+ return 1;
+ }
+ return 0 unless $rc && ( $rc == $size );
+
+ my $regex = $opt->{regex};
+ return $buffer =~ /$regex/m;
+}
+
+=head2 $res->reset()
+
+Resets the resource back to the beginning. This is only called if
+C<needs_line_scan()> is true, but not always if C<needs_line_scan()>
+is true.
+
+=cut
+
+sub reset {
+ my $self = shift;
+
+ seek( $self->{fh}, 0, 0 )
+ or App::Ack::warn( "$self->{filename}: $!" );
+
+ return;
+}
+
+=head2 $res->next_text()
+
+API: Gets the next line of text from the resource. Returns true
+if there is one, or false if not.
+
+Sets C<$_> with the line of text, and C<$.> for the ID number of
+the text. This basically emulates a call to C<< <$fh> >>.
+
+=cut
+
+sub next_text {
+ $_ = readline $_[0]->{fh};
+ if ( defined $_ ) {
+ $. = ++$_[0]->{line};
+ return 1;
+ }
+
+ return;
+}
+
+=head2 $res->close()
+
+API: Close the resource.
+
+=cut
+
+sub close {
+ my $self = shift;
+
+ if ( not close $self->{fh} ) {
+ App::Ack::warn( $self->name() . ": $!" );
+ }
+
+ return;
+}
+
+package App::Ack::Repository::Basic;
+
+=head1 App::Ack::Repository::Basic
+
+=cut
+
+our @ISA = qw( App::Ack::Repository );
+
+
+use warnings;
+use strict;
+
+sub new {
+ my $class = shift;
+ my $filename = shift;
+
+ my $self = bless {
+ filename => $filename,
+ nexted => 0,
+ }, $class;
+
+ return $self;
+}
+
+=head2 next_resource
+
+Returns a resource object for the next resource in the repository.
+
+=cut
+
+sub next_resource {
+ my $self = shift;
+
+ return if $self->{nexted};
+ $self->{nexted} = 1;
+
+ return App::Ack::Resource::Basic->new( $self->{filename} );
+}
+
+=head2 close
+
+Does nothing. For the base repository, the opening & closing are
+handled at the resource level.
+
+If this repository were, say, an Excel workbook, you'd probably
+close the file. If it were a database, you'd close the database
+connection.
+
+=cut
+
+sub close {
+}
+
+
+
+1;
View
11 Makefile.PL
@@ -13,10 +13,11 @@ my %parms = (
VERSION_FROM => 'Ack.pm',
PM => {
'Ack.pm' => '$(INST_LIBDIR)/App/Ack.pm',
- 'Plugin.pm' => '$(INST_LIBDIR)/App/Ack/Plugin.pm',
'Repository.pm' => '$(INST_LIBDIR)/App/Ack/Repository.pm',
'Resource.pm' => '$(INST_LIBDIR)/App/Ack/Resource.pm',
- 'Tar.pm' => '$(INST_LIBDIR)/App/Ack/Repository/Tar.pm',
+ 'Plugin.pm' => '$(INST_LIBDIR)/App/Ack/Plugin.pm',
+ 'Basic.pm' => '$(INST_LIBDIR)/App/Ack/Plugin/Basic.pm',
+ 'Tar.pm' => '$(INST_LIBDIR)/App/Ack/Plugin/Tar.pm',
},
EXE_FILES => [ 'ack' ],
PREREQ_PM => {
@@ -63,9 +64,10 @@ sub MY::postamble {
my $postamble = <<'MAKE_FRAG';
ACK = ack
ACK_PM = Ack.pm
+BASIC_PM = Basic.pm
REPOSITORY_PM = Repository.pm
RESOURCE_PM = Resource.pm
-ALL_PM = $(ACK_PM) $(REPOSITORY_PM) $(RESOURCE_PM)
+ALL_PM = $(ACK_PM) $(REPOSITORY_PM) $(RESOURCE_PM) $(BASIC_PM)
STANDALONE = ack-standalone
ACK_HELP = ack-help.txt
ACK_HELP_TYPES = ack-help-types.txt
@@ -87,7 +89,8 @@ critic:
tidy:
perltidy -b -pro=perltidyrc ack $(ALL_PM)
-PROF_ARGS = -Mblib ack-standalone --noenv --color --group -w foo ~/parrot
+#PROF_ARGS = -Mblib ack-standalone --noenv --color --group -w foo ~/parrot
+PROF_ARGS = -Mblib ./ack --noenv --color --group -w foo ~/parrot
timed: all
$(PERL) $(PROF_ARGS) >> /dev/null 2>&1
View
33 Plugin.pm
@@ -2,20 +2,37 @@ package App::Ack::Plugin;
=head1 OVERVIEW
+The premise is that each file is a repository of zero or more
+resources. Each resource contains zero or more lines of text, which
+ack will process.
-The premise is that each file is a repository of zero
-or more resources. Each resource contains zero or more lines of text,
-which ack will process.
+For the basic text file that ack handles now, it's simple: Each
+text file is a repository that has one resource. The repository
+and resource are the same.
-For the basic text file that ack handles now, it's simple: Each text
-file is a repository that has one resource. The repository and
-resource are the same.
-
-You can look at Repository.pm and Resource.pm and see how I'm calling
+You can look at Repository.pm and Resource.pm and see how I'm calling
it. It's really simple, and there's a lot of overhead.
Maybe now's the time for me to work on Plugin.pod. :-)
+=head1 STRUCTURE
+
+Say you have code that will let you search through DLL files.
+
+=head2 App/Ack/Plugin/DLL.pm
+
+ package App::Ack::Plugin::DLL;
+
+
+ package App::Ack::Resource::DLL;
+
+ our @ISA = qw( App::Ack::Resource );
+
+
+ package App::Ack::Repository::DLL;
+
+ our @ISA = qw( App::Ack::Repository );
+
=cut
View
32 Repository.pm
@@ -5,16 +5,21 @@ use App::Ack::Resource;
use warnings;
use strict;
-sub new {
- my $class = shift;
- my $filename = shift;
+sub FAIL {
+ require Carp;
+ Carp::confess( 'Must be overloaded' );
+}
+
+=head1 METHODS
- my $self = bless {
- filename => $filename,
- nexted => 0,
- }, $class;
+=head2 CLASS->new( $filename )
- return $self;
+Creates an instance of the repository.
+
+=cut
+
+sub new {
+ FAIL();
}
=head2 next_resource
@@ -24,18 +29,12 @@ Returns a resource object for the next resource in the repository.
=cut
sub next_resource {
- my $self = shift;
-
- return if $self->{nexted};
- $self->{nexted} = 1;
-
- return App::Ack::Resource->new( $self->{filename} );
+ FAIL();
}
=head2 close
-Does nothing. For the base repository, the opening & closing are
-handled at the resource level.
+Closes the repository.
If this repository were, say, an Excel workbook, you'd probably
close the file. If it were a database, you'd close the database
@@ -44,6 +43,7 @@ connection.
=cut
sub close {
+ FAIL();
}
1;
View
94 Resource.pm
@@ -5,6 +5,16 @@ use App::Ack;
use warnings;
use strict;
+sub FAIL {
+ require Carp;
+ Carp::confess( 'Must be overloaded' );
+}
+
+=head1 SYNOPSIS
+
+This is the base class for App::Ack::Resource and any resources
+that derive from it.
+
=head1 METHODS
=head2 new( $filename )
@@ -17,30 +27,7 @@ If there's a failure, it throws a warning and returns an empty list.
=cut
sub new {
- my $class = shift;
- my $filename = shift;
-
- my $self = bless {
- filename => $filename,
- fh => undef,
- could_be_binary => undef,
- opened => undef,
- id => undef,
- }, $class;
-
- if ( $self->{filename} eq '-' ) {
- $self->{fh} = *STDIN;
- $self->{could_be_binary} = 0;
- }
- else {
- if ( !open( $self->{fh}, '<', $self->{filename} ) ) {
- App::Ack::warn( "$self->{filename}: $!" );
- return;
- }
- $self->{could_be_binary} = 1;
- }
-
- return $self;
+ FAIL();
}
=head2 $res->name()
@@ -50,9 +37,7 @@ Returns the name of the resource.
=cut
sub name {
- my $self = shift;
-
- return $self->{filename};
+ FAIL();
}
=head2 $res->is_binary()
@@ -63,13 +48,7 @@ match in the file, then ack will not try to display a match line.
=cut
sub is_binary() {
- my $self = shift;
-
- if ( $self->{could_be_binary} ) {
- return -B $self->{filename};
- }
-
- return 0;
+ FAIL();
}
@@ -88,29 +67,7 @@ have to do the line-by-line, too.
=cut
sub needs_line_scan {
- my $self = shift;
- my $opt = shift;
-
- return 1 if $opt->{v};
-
- my $size = -s $self->{fh};
- if ( $size == 0 ) {
- return 0;
- }
- elsif ( $size > 100_000 ) {
- return 1;
- }
-
- my $buffer;
- my $rc = sysread( $self->{fh}, $buffer, $size );
- if ( not defined $rc ) {
- App::Ack::warn( "$self->{filename}: $!" );
- return 1;
- }
- return 0 unless $rc && ( $rc == $size );
-
- my $regex = $opt->{regex};
- return $buffer =~ /$regex/m;
+ FAIL();
}
=head2 $res->reset()
@@ -122,12 +79,7 @@ is true.
=cut
sub reset {
- my $self = shift;
-
- seek( $self->{fh}, 0, 0 )
- or App::Ack::warn( "$self->{filename}: $!" );
-
- return;
+ FAIL();
}
=head2 $res->next_text()
@@ -141,13 +93,7 @@ the text. This basically emulates a call to C<< <$fh> >>.
=cut
sub next_text {
- $_ = readline $_[0]->{fh};
- if ( defined $_ ) {
- $. = ++$_[0]->{line};
- return 1;
- }
-
- return;
+ FAIL();
}
=head2 $res->close()
@@ -157,13 +103,7 @@ API: Close the resource.
=cut
sub close {
- my $self = shift;
-
- if ( not close $self->{fh} ) {
- App::Ack::warn( $self->name() . ": $!" );
- }
-
- return;
+ FAIL();
}
1;
View
2 Tar.pm
@@ -1,3 +1,5 @@
+package App::Ack::Plugin::Tar;
+
package App::Ack::Repository::Tar;
use Archive::Tar;
View
4 ack
@@ -6,6 +6,8 @@ Handle tarballs: .rb inside .tar inside .gz
The filetypes check breaks encapsulation.
+Don't install Resource.pm and Repository.pm if we don't have to.
+
=cut
use warnings;
@@ -69,7 +71,7 @@ sub main {
my $s = $nargs == 1 ? '' : 's';
App::Ack::warn( "Ignoring $nargs argument$s on the command-line while acting as a filter." );
}
- my $res = App::Ack::Resource->new( '-' );
+ my $res = App::Ack::Resource::Basic->new( '-' );
App::Ack::search_resource( $res, $opt );
$res->close();
exit 0;
View
123 ack-standalone
@@ -10,6 +10,8 @@ Handle tarballs: .rb inside .tar inside .gz
The filetypes check breaks encapsulation.
+Don't install Resource.pm and Repository.pm if we don't have to.
+
=cut
use warnings;
@@ -72,7 +74,7 @@ sub main {
my $s = $nargs == 1 ? '' : 's';
App::Ack::warn( "Ignoring $nargs argument$s on the command-line while acting as a filter." );
}
- my $res = App::Ack::Resource->new( '-' );
+ my $res = App::Ack::Resource::Basic->new( '-' );
App::Ack::search_resource( $res, $opt );
$res->close();
exit 0;
@@ -1822,7 +1824,7 @@ sub search_resource {
my $before_starts_at_line;
my $after = 0; # number of lines still to print after a match
- while ( $res->next_text() ) {
+ while ( $res->next_text ) {
# XXX Optimize away the case when there are no more @lines to find.
# XXX $has_lines, $passthru and $v never change. Optimize.
if ( $has_lines
@@ -2027,7 +2029,7 @@ sub print_files_with_matches {
my $nmatches = 0;
while ( defined ( my $filename = $iter->() ) ) {
- my $repo = App::Ack::Repository->new( $filename );
+ my $repo = App::Ack::Repository::Basic->new( $filename );
my $res;
while ( $res = $repo->next_resource() ) {
$nmatches += search_and_list( $res, $opt );
@@ -2052,11 +2054,12 @@ sub print_matches {
while ( defined ( my $filename = $iter->() ) ) {
my $repo;
if ( $filename =~ /\.tar\.gz$/ ) {
+ App::Ack::die( 'Not working here yet' );
require App::Ack::Repository::Tar; # XXX Error checking
$repo = App::Ack::Repository::Tar->new( $filename );
}
else {
- $repo = App::Ack::Repository->new( $filename );
+ $repo = App::Ack::Repository::Basic->new( $filename );
}
$repo or next;
@@ -2226,36 +2229,85 @@ package App::Ack::Repository;
use warnings;
use strict;
-sub new {
- my $class = shift;
- my $filename = shift;
+sub FAIL {
+ require Carp;
+ Carp::confess( 'Must be overloaded' );
+}
- my $self = bless {
- filename => $filename,
- nexted => 0,
- }, $class;
- return $self;
+sub new {
+ FAIL();
}
sub next_resource {
- my $self = shift;
+ FAIL();
+}
+
+
+sub close {
+ FAIL();
+}
+
+1;
+package App::Ack::Resource;
+
+
+use warnings;
+use strict;
+
+sub FAIL {
+ require Carp;
+ Carp::confess( 'Must be overloaded' );
+}
+
+
+sub new {
+ FAIL();
+}
+
+
+sub name {
+ FAIL();
+}
+
+
+sub is_binary() {
+ FAIL();
+}
+
+
+
+sub needs_line_scan {
+ FAIL();
+}
- return if $self->{nexted};
- $self->{nexted} = 1;
- return App::Ack::Resource->new( $self->{filename} );
+sub reset {
+ FAIL();
+}
+
+
+sub next_text {
+ FAIL();
}
sub close {
+ FAIL();
}
1;
-package App::Ack::Resource;
+package App::Ack::Plugin::Basic;
+
+package App::Ack::Resource::Basic;
+
+
+
+our @ISA = qw( App::Ack::Resource );
+
use warnings;
use strict;
@@ -2365,4 +2417,41 @@ sub close {
return;
}
+package App::Ack::Repository::Basic;
+
+
+our @ISA = qw( App::Ack::Repository );
+
+
+use warnings;
+use strict;
+
+sub new {
+ my $class = shift;
+ my $filename = shift;
+
+ my $self = bless {
+ filename => $filename,
+ nexted => 0,
+ }, $class;
+
+ return $self;
+}
+
+
+sub next_resource {
+ my $self = shift;
+
+ return if $self->{nexted};
+ $self->{nexted} = 1;
+
+ return App::Ack::Resource::Basic->new( $self->{filename} );
+}
+
+
+sub close {
+}
+
+
+
1;
View
15 t/standalone.t
@@ -22,15 +22,18 @@ else {
}
FIND_PACKAGES: {
- my @expected = (
- 'package File::Next;',
- 'package App::Ack;',
- 'package App::Ack::Repository;',
- 'package App::Ack::Resource;',
+ my @expected = map { "package $_;" } qw(
+ File::Next
+ App::Ack
+ App::Ack::Plugin::Basic
+ App::Ack::Repository
+ App::Ack::Repository::Basic
+ App::Ack::Resource
+ App::Ack::Resource::Basic
);
my @files = ( $ack );
my @args = qw( ^package -h );
my @results = run_ack( @args, @files );
- lists_match( \@results, \@expected, 'Looking for packages' );
+ sets_match( \@results, \@expected, 'Looking for packages' );
}

0 comments on commit eb3f7bd

Please sign in to comment.
Something went wrong with that request. Please try again.