File: findrule

package info (click to toggle)
libfile-find-rule-perl 0.30-2
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 112 kB
  • ctags: 25
  • sloc: perl: 610; makefile: 38
file content (138 lines) | stat: -rw-r--r-- 3,318 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
#!perl -w
use strict;
use File::Find::Rule;
use File::Spec::Functions qw(catdir);

# bootstrap extensions
for (@INC) {
    my $dir = catdir($_, qw( File Find Rule ) );
    next unless -d $dir;
    my @pm = find( name => '*.pm', maxdepth => 1,
                   exec => sub { (my $name = $_) =~ s/\.pm$//;
                                 eval "require File::Find::Rule::$name"; },
                   in => $dir );
}

# what directories are we searching in?
my @where;
while (@ARGV) {
    local $_ = shift @ARGV;
    if (/^-/) {
        unshift @ARGV, $_;
        last;
    }
    push @where, $_;
}

# parse arguments, build a rule object
my $rule = new File::Find::Rule;
while (@ARGV) {
    my $clause = shift @ARGV;

    unless ( $clause =~ s/^-// && $rule->can( $clause ) ) {
        # not a known rule - complain about this
        die "unknown option '$clause'\n"
    }

    # it was the last switch
    unless (@ARGV) {
        $rule->$clause();
        next;
    }

    # consume the parameters
    my $param = shift @ARGV;

    if ($param =~ /^-/) {
        # it's the next switch - put it back, and add one with no params
        unshift @ARGV, $param;
        $rule->$clause();
        next;
    }

    if ($param eq '(') {
        # multiple values - just look for the closing parenthesis
        my @p;
        while (@ARGV) {
            my $val = shift @ARGV;
            last if $val eq ')';
            push @p, $val;
        }
        $rule->$clause( @p );
        next;
    }

    # a single argument
    $rule->$clause( $param );
}

# add a print rule so things happen faster
$rule->exec( sub { print "$_[2]\n"; return; } );

# profit
$rule->in( @where ? @where : '.' );
exit 0;

__END__

=head1 NAME

findrule - command line wrapper to File::Find::Rule

=head1 USAGE

  findrule [path...] [expression]

=head1 DESCRIPTION

C<findrule> mostly borrows the interface from GNU find(1) to provide a
command-line interface onto the File::Find::Rule heirarchy of modules.

The syntax for expressions is the rule name, preceded by a dash,
followed by an optional argument.  If the argument is an opening
parenthesis it is taken as a list of arguments, terminated by a
closing parenthesis.

Some examples:

 find -file -name ( foo bar )

files named C<foo> or C<bar>, below the current directory.

 find -file -name foo -bar

files named C<foo>, that have pubs (for this is what our ficticious
C<bar> clause specifies), below the current directory.

 find -file -name ( -bar )

files named C<-bar>, below the current directory.  In this case if
we'd have omitted the parenthesis it would have parsed as a call to
name with no arguments, followed by a call to -bar.

=head2 Supported switches

I'm very slack.  Please consult the File::Find::Rule manpage for now,
and prepend - to the commands that you want.

=head2 Extra bonus switches

findrule automatically loads all of your installed File::Find::Rule::*
extension modules, so check the documentation to see what those would be.

=head1 AUTHOR

Richard Clamp <richardc@unixbeard.net> from a suggestion by Tatsuhiko Miyagawa

=head1 COPYRIGHT

Copyright (C) 2002 Richard Clamp.  All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 SEE ALSO

L<File::Find::Rule>

=cut