daily pastebin goal
56%
SHARE
TWEET

Untitled

a guest Feb 5th, 2018 94 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  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.append(
  47.     'no|=a' => 'exclude file category.',
  48.     'only|=s' => 'only search given category.',
  49.     :radio
  50. );
  51. $os.push(
  52.     'd|debug=b',
  53.     'print debug message.'
  54. );
  55. my $id = $os.insert-pos(
  56.     "directory",
  57.     sub find-and-print-source($os, $dira) {
  58.         my @stack = $dira.value;
  59.         my (@t1, @t2);
  60.         my ($debug, $ignore-case) = ($os<d>, $os<i>);
  61.  
  62.         @t1 = do {
  63.             my @t;
  64.             with $os<only> {
  65.                 fail "Not recognized category: {$_}." unless $_ (elem) < c h cpp cfg m a w >;
  66.                 @t := $_ eq "w" ?? [] !! ($os{$_} // []);
  67.             } else {
  68.                 @t = [];
  69.                 for < c h cpp cfg m a > {
  70.                     if $_ !(elem) @($os<no>) {
  71.                         @t.append($os{$_} // []);
  72.                     }
  73.                 }
  74.             }
  75.             @t = @t>>.lc if $ignore-case;
  76.             flat( @t Z, (True xx +@t));
  77.         };
  78.         @t2 = do {
  79.             my @t;
  80.             @t = ($os.get('only').has-value && $os<only> ne "w") ?? [] !! (
  81.                 ("w" (elem) @($os<no>)) ?? [] !! ($os<w> // [])
  82.             );
  83.             @t = @t>>.lc if $ignore-case;
  84.             flat( @t Z, (True xx +@t));
  85.         };
  86.         my %ext := Map.new(@t1);
  87.         my %whole := Map.new(@t2);
  88.  
  89.         note "GET ALL EXT => ", %ext if $debug;
  90.  
  91.         my $supplier = Supplier.new;
  92.  
  93.         my $p = start react whenever $supplier.Supply {
  94.             put Q :qq '"$_"';
  95.         };
  96.  
  97.         sleep 0.001 while $p.status != Planned;
  98.         while @stack {
  99.             note "CURR FILES => ", @stack if $debug;
  100.             my @stack-t = (@stack.race.map(
  101.                                   sub ($_) {
  102.                                       note "\t|GOT FILE => ", $_ if $debug;
  103.                                       if nqp::lstat(nqp::unbox_s($_), nqp::const::STAT_ISDIR) == 1 {
  104.                                           return .&getSubFiles;
  105.                                       } else {
  106.                                           my $fp  = &basename($_);
  107.                                           my $ext = $fp.substr(($fp.rindex(".") // -1) + 1);
  108.  
  109.                                           note "\t=>GOT EXT = ", $ext if $debug;
  110.                                           if %ext{$ignore-case ?? $ext.lc !! $ext} || (%whole{$ignore-case ?? $fp.lc !! $fp} ) {
  111.                                               note "\t\t|SEND FILE ", $_ if $debug;
  112.                                               $supplier.emit($_);
  113.                                           }
  114.                                       }
  115.                                       return ();
  116.                                   }
  117.                               ).flat);
  118.             @stack = @stack-t;
  119.         };
  120.     },
  121.     :last
  122. );
  123.  
  124. &getopt($os);
  125.  
  126. sub basename($filepath) {
  127.     return $filepath.substr(($filepath.rindex('/') // -1) + 1);
  128. }
  129.  
  130. sub getSubFiles($path) {
  131.     my @ret := [];
  132.     my $dh := nqp::opendir($path);
  133.  
  134.     while (my $f = nqp::nextfiledir($dh)) {
  135.         @ret.push("$path/$f") if $f ne ".." && $f ne ".";
  136.     }
  137.  
  138.     nqp::closedir($dh);
  139.  
  140.     return @ret;
  141. }
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top