Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #!/usr/bin/env perl6
- use nqp;
- use Getopt::Advance;
- my OptionSet $os .= new;
- $os.push(
- 'c=a',
- 'c source file extension list.',
- value => [ "c", ]
- );
- $os.push(
- 'h=a',
- 'head file extension list.',
- value => [ "h", ]
- );
- $os.push(
- 'cpp|=a',
- 'cpp source file extension list.',
- value => Q :w ! C cpp c++ cxx hpp cc h++ hh hxx!
- );
- $os.push(
- 'cfg|=a',
- 'config file extension list.',
- value => Q :w ! ini config conf cfg xml !
- );
- $os.push(
- 'm=a',
- 'makefile extension list.',
- value => ["mk", ]
- );
- $os.push(
- 'w=a',
- 'match whole filename.',
- value => Q :w ! makefile Makefile !
- );
- $os.push(
- 'a=a',
- 'addition extension list.',
- );
- $os.push(
- 'i=b',
- 'enable ignore case mode.'
- );
- $os.append(
- 'no|=a' => 'exclude file category.',
- 'only|=s' => 'only search given category.',
- :radio
- );
- $os.push(
- 'd|debug=b',
- 'print debug message.'
- );
- my $id = $os.insert-pos(
- "directory",
- sub find-and-print-source($os, $dira) {
- my @stack = $dira.value;
- my (@t1, @t2);
- my ($debug, $ignore-case) = ($os<d>, $os<i>);
- @t1 = do {
- my @t;
- with $os<only> {
- fail "Not recognized category: {$_}." unless $_ (elem) < c h cpp cfg m a w >;
- @t := $_ eq "w" ?? [] !! ($os{$_} // []);
- } else {
- @t = [];
- for < c h cpp cfg m a > {
- if $_ !(elem) @($os<no>) {
- @t.append($os{$_} // []);
- }
- }
- }
- @t = @t>>.lc if $ignore-case;
- flat( @t Z, (True xx +@t));
- };
- @t2 = do {
- my @t;
- @t = ($os.get('only').has-value && $os<only> ne "w") ?? [] !! (
- ("w" (elem) @($os<no>)) ?? [] !! ($os<w> // [])
- );
- @t = @t>>.lc if $ignore-case;
- flat( @t Z, (True xx +@t));
- };
- my %ext := Map.new(@t1);
- my %whole := Map.new(@t2);
- note "GET ALL EXT => ", %ext if $debug;
- my $supplier = Supplier.new;
- my $p = start react whenever $supplier.Supply {
- put Q :qq '"$_"';
- };
- sleep 0.001 while $p.status != Planned;
- while @stack {
- note "CURR FILES => ", @stack if $debug;
- my @stack-t = (@stack.race.map(
- sub ($_) {
- note "\t|GOT FILE => ", $_ if $debug;
- if nqp::lstat(nqp::unbox_s($_), nqp::const::STAT_ISDIR) == 1 {
- return .&getSubFiles;
- } else {
- my $fp = &basename($_);
- my $ext = $fp.substr(($fp.rindex(".") // -1) + 1);
- note "\t=>GOT EXT = ", $ext if $debug;
- if %ext{$ignore-case ?? $ext.lc !! $ext} || (%whole{$ignore-case ?? $fp.lc !! $fp} ) {
- note "\t\t|SEND FILE ", $_ if $debug;
- $supplier.emit($_);
- }
- }
- return ();
- }
- ).flat);
- @stack = @stack-t;
- };
- },
- :last
- );
- &getopt($os);
- sub basename($filepath) {
- return $filepath.substr(($filepath.rindex('/') // -1) + 1);
- }
- sub getSubFiles($path) {
- my @ret := [];
- my $dh := nqp::opendir($path);
- while (my $f = nqp::nextfiledir($dh)) {
- @ret.push("$path/$f") if $f ne ".." && $f ne ".";
- }
- nqp::closedir($dh);
- return @ret;
- }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement