tools/tango

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 #use vars qw(\$version \$help \$verbose \$lang \@includes \%ents);
   5 use Getopt::Long;
   6
   7 sub print_revision ($$);
   8 sub print_usage ($$);
   9 sub print_help ($$);
  10 sub slurp ($$$@);
  11
  12 my $PROGNAME = "tango";
  13 my $REVISION = '$Revision$ ';
  14 $REVISION =~ s/^\$Revision: //;
  15 $REVISION =~ s/ \$ $//;
  16
  17 my $PACKAGE = 'Monitoring Plugins';
  18 my $RELEASE = '1.3';
  19 my $WARRANTY = "The Monitoring Plugins come with ABSOLUTELY NO WARRANTY. You may redistribute\ncopies of the plugins under the terms of the GNU General Public License.\nFor more information about these matters, see the file named COPYING.\n";
  20
  21 my $version = undef;
  22 my $help = undef;
  23 my $verbose = undef;
  24 my $lang = undef;
  25 my $follow = undef;
  26 my @INCLUDE = undef;
  27
  28 Getopt::Long::Configure('bundling');
  29 GetOptions
  30         ("V"   => \$version,  "version"    => \$version,
  31          "h"   => \$help,     "help"       => \$help,
  32          "v"   => \$verbose,  "verbose"    => \$verbose,
  33          "f"   => \$follow,  "follow!"     => \$follow,
  34          "l=s" => \$lang,     "language=s" => \$lang,
  35          "I=s" => \@INCLUDE);
  36
  37 if ($help) {
  38         print_help ($PROGNAME,$REVISION);
  39         exit 0;
  40 }
  41
  42 if ($version) {
  43         print_revision ($PROGNAME,$REVISION);
  44         exit 0;
  45 }
  46
  47 if (!defined($lang)) {
  48         print_usage ($PROGNAME,$REVISION);
  49         exit 1;
  50 }
  51
  52 my $t;
  53 my @files;
  54 my $file;
  55 my $key;
  56 my $ent;
  57 my $cmd;
  58 my $dir;
  59
  60 # first step is to get a set of defines in effect
  61 # we do this with gcc preprocessor
  62 #
  63 # first, assemble the command
  64 my $cmd = "/usr/bin/gcc -E -dM";
  65 foreach $dir (@INCLUDE) {
  66         $cmd .= " -I $dir" if ($dir) ;
  67 }
  68
  69 # add the file(s) to process
  70 while ($file = shift) {
  71         push @files, $file;
  72         $cmd .= " $file";
  73 }
  74
  75 # then execute the command, storing defines in %main::ents
  76 open T, "$cmd |";
  77 while (<T>) {
  78         next if (m|\#define\s+[^\s\(]+\(|);
  79         if (m|\#define\s+(\S+)\s+(\"?)(.*?)\2$|) {
  80                 $key = $1;
  81                 $ent = $3;
  82                 $ent =~ s|\\n\\n|</para>\n\n<para>|msg;
  83                 $ent =~ s|\\n|\n|msg;
  84                 $main::ents{$key} = $ent;
  85         }
  86 }
  87
  88 # then we slurp the file to fetch the XML
  89 my $xml = "";
  90 foreach $file (@files) {
  91         $xml .= slurp ($lang, $follow, $file, @INCLUDE);
  92 }
  93
  94 # finally substitute the defines as XML entities
  95 foreach $key (keys %main::ents) {
  96         $xml =~ s/\&$key\;/$main::ents{$key}/msg;
  97 }
  98
  99 # and print the result
 100 print $xml;
 101
 102 exit 0;
 103
 104 sub print_revision ($$) {
 105         my $PROGNAME = shift;
 106         my $REVISION = shift;
 107         print "$PROGNAME ($PACKAGE $RELEASE) $REVISION\n";
 108         print "$WARRANTY";
 109 }
 110
 111 sub print_usage ($$) {
 112         my $PROGNAME = shift;
 113         my $REVISION = shift;
 114         print qq"\n$PROGNAME -l <language> [options] file [...]\n"
 115 }
 116
 117 sub print_help ($$) {
 118         my $PROGNAME = shift;
 119         my $REVISION = shift;
 120         print_usage ($PROGNAME, $REVISION);
 121         print qq"
 122 Options:
 123   -l, --language=STRING
 124      Currently supported languages are C and perl
 125 ";
 126 }
 127
 128 sub slurp ($$$@) {
 129         no strict 'refs';
 130         my ($lang, $follow, $file, @INCLUDE) = @_;
 131         my $xml = "";
 132         my $block;
 133         my $dir = "";
 134         my $ostat;
 135         my $descriptor = 'T' . int(rand 100000000);
 136
 137         if ($file !~ m|^[\.\/\\]|) {
 138                 foreach $dir (@INCLUDE) {
 139                         if ($ostat = open $descriptor, "<$dir/$file") {
 140                                 push @main::includes, $file;
 141                                 last;
 142                         }
 143                 }
 144         } else {
 145                 $ostat = open $descriptor, "<$file";
 146                 push @main::includes, $file if $ostat;
 147         }
 148         return "" unless $ostat;
 149
 150         if ($lang eq 'C') {
 151                 while (<$descriptor>) {
 152                         $block = $_;
 153                         if ($follow && m|^\s*\#\s*include\s+[<"]([^\">]+)[">]|) {
 154                                 $xml .= slurp ($lang, $follow, $1, @INCLUDE) unless (in (@main::includes, $1));
 155                         }
 156                         if ($block =~ m|(\S+)\s+(\S+)\s*(\([^\)]*\));|) {
 157                                 $main::ents{"PROTO_$2"} = "$1 $2 $3";
 158                         }
 159                         if ($block =~ m|//|) { # C++ style one-line comment
 160                                 if (m|//\@\@-(.*)-\@\@|) {
 161                                         $xml .= $1;
 162                                 }
 163                         }
 164                         if ($block =~ m|/\*|) { # normal C comments
 165                                 while ($block !~ m|/\*(.*)\*/|ms) {
 166                                         $block .= <$descriptor>;
 167                                 }
 168                                 if ($block =~ m|\@\@-(.*)-\@\@|ms) {
 169                                         $xml .= $1;
 170                                 } elsif ($block =~ m|\@s*-(.*)\s*-\@|ms) {
 171                                         $key = $1;
 172                                         while ($block !~ m|\*/\s*([^\;]+);|ms) {
 173                                                 $block .= <$descriptor>;
 174                                         }
 175                                         if ($block =~ m|\*/\s*([^\;]+);|ms) {
 176                                                 $main::ents{$key} = $1;
 177                                         }
 178                                 }
 179                         }
 180                 }
 181         }
 182         close $descriptor;
 183         return $xml;
 184 }
 185
 186 sub in () {
 187         my $el = pop;
 188         foreach $key (@_) {
 189                 return 1 if ($key eq $el);
 190         }
 191         return 0;
 192 }
 193
 194 sub CommentStart ($) {
 195         my $lang = shift;
 196         if ($lang eq 'C') {
 197                 return '/*';
 198         } elsif ($lang == 'perl') {
 199                 return '#';
 200         } else {
 201                 return undef;
 202         }
 203 }
 204
 205 #                       if ($_ =~ m/^\s*\#\s*define\s+([-_a-zA-Z0-9]+)\s+(.*)\s*$/) {
 206 #                               $key = $1;
 207 #                               $main::ents{$key} = "$2";
 208 #                               while (($main::ents{$key} =~ s/\\\s*$//s) && ($block = <$descriptor>)) {
 209 #                                       $main::ents{$key} .= $block;
 210 #                               }
 211 #                               $main::ents{$key} =~ s/"(.*)"$/$1/s;
 212 #                               $main::ents{$key} =~ s/\s+\/[\/\*].*$//s;
 213 #                       }
 214
 215 ### Local Variables: ;;;
 216 ### tab-width: 2 ;;;
 217 ### perl-indent-level: 2 ;;;
 218 ### End: ;;;