Home | History | Annotate | Line # | Download | only in mantools
      1  1.1  tron #!/usr/bin/perl
      2  1.1  tron 
      3  1.1  tron use Getopt::Std;
      4  1.1  tron 
      5  1.1  tron # xpostconf - extract parameter info from postconf prototype file
      6  1.1  tron 
      7  1.1  tron # Usage: xpostconf [options] protofile [parameter...]
      8  1.1  tron #
      9  1.1  tron # -b: Brief output: print only the first sentence of each definition
     10  1.1  tron #
     11  1.1  tron # -c: print the classes named on the command line (default: all).
     12  1.1  tron #
     13  1.1  tron # -h: print help message.
     14  1.1  tron #
     15  1.1  tron # -p: print the parameters named on the command line (default: all).
     16  1.1  tron #
     17  1.1  tron # -s specfile: process the entries listed in the named file: ordinary
     18  1.1  tron # text is copied as is, 
     19  1.1  tron #	%CLASS class-name mode
     20  1.1  tron #	%PARAM param-name mode
     21  1.1  tron # are replaced by the respective information. Mode is b (brief)
     22  1.1  tron # f (full) or i (ignore).
     23  1.1  tron #
     24  1.1  tron # If no -s is specified, extracts the named parameter text (all
     25  1.1  tron # parameters by default).
     26  1.1  tron 
     27  1.1  tron $opt_b = undef;
     28  1.1  tron $opt_c = undef;
     29  1.1  tron $opt_p = undef;
     30  1.1  tron $opt_s = undef;
     31  1.1  tron $opt_v = undef;
     32  1.1  tron getopts("bcps:v");
     33  1.1  tron 
     34  1.1  tron die "Usage: $0 [-bcpv] [-s specfile] protofile [parameter...]\n" 
     35  1.1  tron 	unless $protofile = shift(@ARGV);
     36  1.1  tron 
     37  1.1  tron # Save one definition.
     38  1.1  tron 
     39  1.1  tron sub save_text {
     40  1.1  tron     if ($category eq "PARAM") {
     41  1.1  tron 	$param_text{$name} = $text;
     42  1.1  tron 	if ($opt_v) {
     43  1.1  tron 	    printf "saving entry %s %.20s..\n", $name, $text;
     44  1.1  tron 	} 
     45  1.1  tron     } elsif ($category eq "CLASS") {
     46  1.1  tron 	$class_text{$name} = $text;
     47  1.1  tron 	if ($opt_v) {
     48  1.1  tron 	    printf "saving class %s %.20s..\n", $name, $text;
     49  1.1  tron 	} 
     50  1.1  tron     } else {
     51  1.1  tron 	die "Unknown category: $category. Need PARAM or CLASS.\n";
     52  1.1  tron     }
     53  1.1  tron }
     54  1.1  tron 
     55  1.1  tron # Read the whole file even if we want to print only one parameter.
     56  1.1  tron 
     57  1.1  tron open(POSTCONF, $protofile) || die " cannot open $protofile: $!\n";
     58  1.1  tron 
     59  1.1  tron while(<POSTCONF>) {
     60  1.1  tron 
     61  1.1  tron     next if /^#/ && $text eq "";
     62  1.1  tron     next unless ($name || /\S/);
     63  1.1  tron 
     64  1.1  tron     if (/^%(PARAM|CLASS)/) {
     65  1.1  tron 
     66  1.1  tron 	# Save the accumulated text.
     67  1.1  tron 
     68  1.1  tron 	if ($name && $text) {
     69  1.1  tron 	    save_text();
     70  1.1  tron 	}
     71  1.1  tron 
     72  1.1  tron 	# Reset the parameter name and accumulated text.
     73  1.1  tron 
     74  1.1  tron 	$name = $text = "";
     75  1.1  tron 	$category = $1;
     76  1.1  tron 
     77  1.1  tron 	# Accumulate the parameter name and default value.
     78  1.1  tron 
     79  1.1  tron 	do {
     80  1.1  tron 	    $text .= $_;
     81  1.1  tron 	} while(($_ = <POSTCONF>) && /\S/);
     82  1.1  tron 	($junk, $name, $junk) = split(/\s+/, $text, 3);
     83  1.1  tron 
     84  1.1  tron     } 
     85  1.1  tron 
     86  1.1  tron     # Accumulate the text in the class or parameter definition.
     87  1.1  tron 
     88  1.1  tron     $text .= $_;
     89  1.1  tron 
     90  1.1  tron }
     91  1.1  tron 
     92  1.1  tron # Save the last definition.
     93  1.1  tron 
     94  1.1  tron if ($name && $text) {
     95  1.1  tron     save_text();
     96  1.1  tron }
     97  1.1  tron 
     98  1.1  tron # If working from a spec file, emit output in the specified order.
     99  1.1  tron 
    100  1.1  tron if ($opt_s) {
    101  1.1  tron     open(SPEC, "$opt_s") || die "cannot open $opt_s: $!\m";
    102  1.1  tron     while(<SPEC>) {
    103  1.1  tron 	if (/^%/) {
    104  1.1  tron 	    ($category, $name, $mode) = split(/\s+/, substr($_, 1));
    105  1.1  tron 	    if ($category eq "CLASS") {
    106  1.1  tron 		die "Unknown class name: $name.\n" 
    107  1.1  tron 		    unless $text = $class_text{$name};
    108  1.1  tron 	    } elsif ($category eq "PARAM") {
    109  1.1  tron 		die "Unknown parameter name: $name.\n"
    110  1.1  tron 		    unless $text = $param_text{$name};
    111  1.1  tron 	    } else {
    112  1.1  tron 		die "Unknown category: $category. Need CLASS or PARAM\n";
    113  1.1  tron 	    }
    114  1.1  tron 	    if ($mode eq "i") {
    115  1.1  tron 		next;
    116  1.1  tron 	    } elsif ($mode eq "b") {
    117  1.1  tron 		$text =~ s/\.\s.*/.\n\n/s;
    118  1.1  tron 	    } elsif ($mode ne "p") {
    119  1.1  tron 		die "Unknown mode: $mode. Need b or p or i,\n";
    120  1.1  tron 	    }
    121  1.1  tron 	    print $text, "\n";
    122  1.1  tron 	} else {
    123  1.1  tron 	    print;
    124  1.1  tron 	}
    125  1.1  tron     }
    126  1.1  tron     exit;
    127  1.1  tron }
    128  1.1  tron 
    129  1.1  tron # Print all the parameters.
    130  1.1  tron 
    131  1.1  tron if ($opt_c) {
    132  1.1  tron     $what = \%class_text;
    133  1.1  tron } else {
    134  1.1  tron     $what = \%param_text;
    135  1.1  tron }
    136  1.1  tron 
    137  1.1  tron if ($#ARGV < 0) {
    138  1.1  tron     for $name (sort keys %{$what}) {
    139  1.1  tron 	$text = ${$what}{$name};
    140  1.1  tron 	$text =~ s/\.\s.*/.\n\n/s if ($opt_b);
    141  1.1  tron 	print $text, "\n";
    142  1.1  tron     }
    143  1.1  tron } 
    144  1.1  tron 
    145  1.1  tron # Print parameters in the specified order.
    146  1.1  tron 
    147  1.1  tron else {
    148  1.1  tron     for $name (@ARGV) {
    149  1.1  tron 	$text = ${$what}{$name};
    150  1.1  tron 	$text =~ s/\.\s.*/.\n\n/s if ($opt_b);
    151  1.1  tron 	print $text;
    152  1.1  tron     }
    153  1.1  tron }
    154