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