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