[csw-devel] SF.net SVN: gar:[19753] csw/mgar/gar/v2/bin/pathfilter

dmichelsen at users.sourceforge.net dmichelsen at users.sourceforge.net
Tue Nov 27 18:39:49 CET 2012


Revision: 19753
          http://gar.svn.sourceforge.net/gar/?rev=19753&view=rev
Author:   dmichelsen
Date:     2012-11-27 17:39:49 +0000 (Tue, 27 Nov 2012)
Log Message:
-----------
mGAR v2: Speedup pathfilter by factor of 50

Modified Paths:
--------------
    csw/mgar/gar/v2/bin/pathfilter

Modified: csw/mgar/gar/v2/bin/pathfilter
===================================================================
--- csw/mgar/gar/v2/bin/pathfilter	2012-11-27 15:56:25 UTC (rev 19752)
+++ csw/mgar/gar/v2/bin/pathfilter	2012-11-27 17:39:49 UTC (rev 19753)
@@ -21,19 +21,41 @@
 
 my ($hasinclude, $hasexclude);
 my @isaexec;
-my @selection;
+my @selection_args;
 my $result = GetOptions(
 	'h|help' => \$help,
 	'e|isaexec=s' => \@isaexec,
-	'i|include=s' => sub { push @selection, [ 'i', $_[1] ]; $hasinclude = 1 },
-	'I=s' => sub { push @selection, [ 'i', quotemeta( $_[1] ) ]; $hasinclude = 1 },
-	'x|exclude=s' => sub { push @selection, [ 'x', $_[1] ]; $hasexclude = 1 },
-	'X=s' => sub { push @selection, [ 'x', quotemeta( $_[1] ) ]; $hasexclude = 1 },
+	'i|include=s' => sub { push @selection_args, [ 'i', $_[1] ]; $hasinclude = 1 },
+	'I=s' => sub { push @selection_args, [ 'i', quotemeta( $_[1] ) ]; $hasinclude = 1 },
+	'x|exclude=s' => sub { push @selection_args, [ 'x', $_[1] ]; $hasexclude = 1 },
+	'X=s' => sub { push @selection_args, [ 'x', quotemeta( $_[1] ) ]; $hasexclude = 1 },
 ) or pod2usage( 1 );
 
 # Exclude everything by default if there are only include rules
-push @selection, [ 'x', '.*' ] if( $hasinclude && !$hasexclude );
+push @selection_args, [ 'x', '.*' ] if( $hasinclude && !$hasexclude );
 
+# @selection = map { [ $_->[0], qr/^$_->[1]$/ ] } @selection;
+
+# This routine anchors all regexps at start and end and combines seqential includes/excludes into a single regex
+my @selection;
+my @seltemp;
+my $mode;
+foreach my $c (@selection_args) {
+  my ($type, $re) = @$c;
+  if( $mode && $mode ne $type ) {
+    # flush
+    my $mre = '^(' . join( '|', @seltemp ) . ')$';
+    push @selection, [ $mode, qr/$mre/ ];
+    @seltemp = ();
+    $mode = $type;
+  }
+  $mode = $type;
+  push @seltemp, $re;
+}
+
+my $mre = '^(' . join( '|', @seltemp ) . ')$';
+push @selection, [ $mode, qr/$mre/ ];
+
 pod2usage(-verbose => 2) if $help;
 
 my %p;
@@ -67,9 +89,9 @@
   foreach my $selector (@selection) {
     my ($type, $regex) = @$selector;
     if( $type eq 'i' ) {
-      last SELECTION if( $path =~ /^$regex$/ );
+      last SELECTION if( $path =~ /$regex/ );
     } elsif( $type eq 'x' ) {
-      next NEXTLINE if( $path =~ /^$regex$/ );
+      next NEXTLINE if( $path =~ /$regex/ );
     } else {
       croak( "The type '$type' is unknown (either 'x' or 'i' is allowed)." );
     }

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.



More information about the devel mailing list