fork download
copy 
  1. #!/usr/bin/env perl6
  2.  
  3. #!/usr/bin/env perl6
  4.  
  5. use nqp;
  6. use Getopt::Advance;
  7.  
  8. my OptionSet $os .= new;
  9.  
  10. $os.push(
  11.     'c=a',
  12.     'c source file extension list.',
  13.     value => [ "c", ]
  14. );
  15. $os.push(
  16.     'h=a',
  17.     'head file extension list.',
  18.     value => [ "h", ]
  19. );
  20. $os.push(
  21.     'cpp|=a',
  22.     'cpp source file extension list.',
  23.     value => Q :w ! C cpp c++ cxx hpp cc h++ hh hxx!
  24. );
  25. $os.push(
  26.     'cfg|=a',
  27.     'config file extension list.',
  28.     value => Q :w ! ini config conf cfg xml !
  29. );
  30. $os.push(
  31.     'm=a',
  32.     'makefile extension list.',
  33.     value => ["mk", ]
  34. );
  35. $os.push(
  36.     'w=a',
  37.     'match whole filename.',
  38.     value => Q :w ! makefile Makefile !
  39. );
  40. $os.push(
  41.     'a=a',
  42.     'addition extension list.',
  43. );
  44. $os.push(
  45.     'i=b',
  46.     'enable ignore case mode.'
  47. );
  48. $os.push(
  49.     'no|=a',
  50.     'exclude file category.',
  51. );
  52. $os.push(
  53.     'only|=s',
  54.     'only search given category.',
  55. );
  56. $os.push(
  57.     'd|debug=b',
  58.     'print debug message.'
  59. );
  60. my $id = $os.insert-pos(
  61.     "directory",
  62.     sub find-and-print-source($os, $dira) {
  63.         my @stack = $dira.value;
  64.         my %ext := set (
  65.             with $os<only> {
  66.                 fail "Not recognized category: {$_}." unless $_ (elem) < c h cpp cfg m a w >;
  67.                 $os{$_} // [];
  68.             } else {
  69.                 my @ext = [];
  70.                 for < c h cpp cfg m a > {
  71.                     if $_ !(elem) @($os<no>) {
  72.                         @ext.append($os{$_} // []);
  73.                     }
  74.                 }
  75.                 @ext;
  76.             }
  77.         );
  78.         my %whole := set($os<w> // []);
  79.  
  80.         note "GET ALL EXT => ", %ext if $os<d>;
  81.  
  82.         my $supplier = Supplier.new;
  83.  
  84.         react {
  85.             start whenever $supplier.Supply {
  86.                 put Q :qq '"$_"';
  87.                 LAST done
  88.             }
  89.         }
  90.  
  91.         while @stack {
  92.             note "CURR FILES => ", @stack if $os<d>;
  93.             my @stack-t = (@stack.race.map(
  94.                                   sub ($_) {
  95.                                       note "\t|GOT FILE => ", $_ if $os<d>;
  96.                                       if nqp::lstat(nqp::unbox_s($_), nqp::const::STAT_ISDIR) == 1 {
  97.                                           return .&getSubFiles;
  98.                                       } else {
  99.                                           my $fp = &basename($_);
  100.                                           if $fp.substr(($fp.rindex(".") // -1) + 1) (elem) %ext {
  101.                                               $supplier.emit($_);
  102.                                           }  elsif $os<w>.defined && $fp (elem) %whole {
  103.                                               $supplier.emit($_);
  104.                                           }
  105.                                       }
  106.                                       return ();
  107.                                   }
  108.                               ).flat);
  109.             @stack = @stack-t;
  110.         };
  111.     },
  112.     :last
  113. );
  114.  
  115. &getopt($os);
  116.  
  117. sub basename($filepath) {
  118.     return $filepath.substr(($filepath.rindex('/') // -1) + 1);
  119. }
  120.  
  121. sub getSubFiles($path) {
  122.     my @ret := [];
  123.     my $dh := nqp::opendir($path);
  124.  
  125.     while (my $f = nqp::nextfiledir($dh)) {
  126.         @ret.push("$path/$f") if $f ne ".." && $f ne ".";
  127.     }
  128.  
  129.     nqp::closedir($dh);
  130.  
  131.     return @ret;
  132. }
  133.  
Runtime error #stdin #stdout #stderr 0.11s 98816KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
stderr
copy 
===SORRY!===
Could not find Getopt::Advance at line 6 in:
    /home/Y1LWth/.perl6
    /usr/share/perl6/site
    /usr/share/perl6/vendor
    /usr/share/perl6
    CompUnit::Repository::AbsolutePath<72352240>
    CompUnit::Repository::NQP<66641680>
    CompUnit::Repository::Perl5<66641720>
https://ideone.com/KbiAdO
language:
Perl (perl 2018.12)
created:
7 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!