home *** CD-ROM | disk | FTP | other *** search
/ Borland Programmer's Resource / Borland_Programmers_Resource_CD_1995.iso / ntcode / ntperlb / eg / status.cmd < prev   
Encoding:
Text File  |  1995-05-19  |  2.4 KB  |  139 lines
  1. @rem = '-*- Perl -*-';
  2. @rem = '
  3. @echo off
  4. perl %0.cmd %1 %2 %3 %4 %5 %6 %7 %8 %9
  5. goto endofperl
  6. ';
  7.  
  8.  
  9. #
  10. # perl script to extract info from status.txt
  11. #
  12. #
  13. # options:
  14. #          -t : look for tested features
  15. #          -u : look for untested features
  16. #          -n : look for not yet implemented features
  17. #          -N : look for not applicable features
  18. #          -a : look for all features
  19. #          -p : print features 
  20. #
  21.  
  22. if ($#ARGV < 0) {
  23.     $opt_a = 1;
  24. }
  25. else {
  26.     require 'getopts.pl';
  27.     &Getopts('ptunNa');
  28. }
  29.  
  30. @allfea = ('Tested', 'Untested', 'NYI', 'N/A');
  31.  
  32. #
  33. # set up regex for searching
  34. #
  35.  
  36. if ($opt_a) {
  37.     $pattern = 'Tested|Untested|NYI|N/A';
  38.     $opt_t = $opt_u = $opt_n = $opt_N = 1;
  39.     @fea = ('Tested', 'Untested', 'NYI', 'N/A');
  40. }
  41. else {
  42.     if ($opt_t) {
  43.     $pattern = 'Tested';
  44.     push(@fea, 'Tested');
  45.     }
  46.     if ($opt_u) {
  47.     $pattern .= '|' if $pattern ne '';
  48.     $pattern .= 'Untested';
  49.     push(@fea, 'Untested');
  50.     }
  51.     if ($opt_n) {
  52.     $pattern .= '|' if $pattern ne '';
  53.     $pattern .= 'NYI';
  54.     push(@fea, 'NYI');
  55.     }
  56.     if ($opt_N) {
  57.     $pattern .= '|' if $pattern ne '';
  58.     $pattern .= 'N/A';
  59.     push (@fea, 'N/A');
  60.     }
  61. }
  62.  
  63. %features = ();
  64.  
  65. open (S, "c:/win32app/ingr/perl/status.txt") 
  66.     || die "Can't open status.txt: $!\n";
  67.  
  68. #
  69. # skip everything up to the first form feed
  70. #
  71.  
  72. while (<S>) {
  73.     last if $_ eq "\f\n";
  74. }
  75.  
  76. &do_header;
  77. $count = 0;
  78. while (<S>) {
  79.     chop;
  80.     (&do_header, next) if $_ eq "\f";
  81.     split;
  82.     print "$_\n" if $opt_p && ($_[1] =~ /$pattern/o);
  83.     $features{$_[1]}++;
  84. }
  85. close S;
  86.  
  87. $total = 0;
  88.  
  89. format top = 
  90.  
  91.    Perl Feature Summary
  92. --------------------------
  93. .
  94.  
  95. format STDOUT = 
  96. @<<<<<<<< @###   @##.##%
  97. $type, $features{$type}, $per
  98. .
  99.  
  100. format totals = 
  101. --------------------------
  102. @<<<<<<<< @###   @##.##%
  103. "Total", $total, 100.00
  104. . 
  105.  
  106. #print "\n\nPerl Feature Summary\n--------------------\n";
  107.  
  108. foreach $type (@allfea) {
  109.     $total += $features{$type};
  110. }
  111.  
  112. $^ = top;
  113.  
  114. foreach $type (@fea) {
  115.     $per = $features{$type} / $total * 100;
  116.     write;
  117. }
  118.  
  119. $~ = totals;
  120. write;
  121.  
  122. #print "page: $%, len: $=, lines left: $-, form: $~ top: $^, formfeed: $^L\n";
  123. exit 0;
  124.  
  125. sub do_header {
  126.     local($a) = scalar(<S>);
  127.     local($b) = scalar(<S>);
  128.     local($c) = scalar(<S>);
  129.     print $a if $opt_p;
  130.     print $b if $opt_p;
  131. }
  132.  
  133. sub usage {
  134.     die "status [-ptunNa]\n";
  135. }
  136.  
  137. __END__
  138. :endofperl
  139.