Advertisement
Guest User

Untitled

a guest
Feb 5th, 2018
236
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 6 3.84 KB | None | 0 0
  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.         @t1 = do {
  61.             my @t;
  62.             with $os<only> {
  63.                 fail "Not recognized category: {$_}." unless $_ (elem) < c h cpp cfg m a w >;
  64.                 @t := $_ eq "w" ?? [] !! ($os{$_} // []);
  65.             } else {
  66.                 @t = [];
  67.                 for < c h cpp cfg m a > {
  68.                     if $_ !(elem) @($os<no>) {
  69.                         @t.append($os{$_} // []);
  70.                     }
  71.                 }
  72.             }
  73.             @t = @t>>.lc if $os<i>;
  74.             flat( @t Z, (True xx +@t));
  75.         };
  76.         @t2 = do {
  77.             my @t;
  78.             @t = ($os.get('only').has-value && $os<only> ne "w") ?? [] !! (
  79.                 ("w" (elem) @($os<no>)) ?? [] !! ($os<w> // [])
  80.             );
  81.             @t = @t>>.lc if $os<i>;
  82.             flat( @t Z, (True xx +@t));
  83.         };
  84.         my %ext := Map.new(@t1);
  85.         my %whole := Map.new(@t2);
  86.  
  87.         note "GET ALL EXT => ", %ext if $os<d>;
  88.  
  89.         my $supplier = Supplier.new;
  90.  
  91.         react {
  92.             start whenever $supplier.Supply {
  93.                 say $_;
  94.                 put Q :qq '"$_"';
  95.                 LAST done
  96.             }
  97.         }
  98.  
  99.         while @stack {
  100.             note "CURR FILES => ", @stack if $os<d>;
  101.             my @stack-t = (@stack.race.map(
  102.                                   sub ($_) {
  103.                                       note "\t|GOT FILE => ", $_ if $os<d>;
  104.                                       if nqp::lstat(nqp::unbox_s($_), nqp::const::STAT_ISDIR) == 1 {
  105.                                           return .&getSubFiles;
  106.                                       } else {
  107.                                           my $fp  = &basename($_);
  108.                                           my $ext = $fp.substr(($fp.rindex(".") // -1) + 1);
  109.  
  110.                                           note "\t=>GOT EXT = ", $ext if $os<d>;
  111.                                           if %ext{$os<i> ?? $ext.lc !! $ext} || (%whole{$os<i> ?? $fp.lc !! $fp} ) {
  112.                                               note "\t\t|SEND FILE ", $_ if $os<d>;
  113.                                               $supplier.emit($_);
  114.                                           }
  115.                                       }
  116.                                       return ();
  117.                                   }
  118.                               ).flat);
  119.             @stack = @stack-t;
  120.         };
  121.     },
  122.     :last
  123. );
  124.  
  125. &getopt($os);
  126.  
  127. sub basename($filepath) {
  128.     return $filepath.substr(($filepath.rindex('/') // -1) + 1);
  129. }
  130.  
  131. sub getSubFiles($path) {
  132.     my @ret := [];
  133.     my $dh := nqp::opendir($path);
  134.  
  135.     while (my $f = nqp::nextfiledir($dh)) {
  136.         @ret.push("$path/$f") if $f ne ".." && $f ne ".";
  137.     }
  138.  
  139.     nqp::closedir($dh);
  140.  
  141.     return @ret;
  142. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement