suntouch-manpages.pl revision 1003
40N/A#!/usr/perl5/bin/perl -w
40N/A
40N/A#
947N/A# Copyright (c) 2006, 2010, Oracle and/or its affiliates. All rights reserved.
40N/A#
40N/A# Permission is hereby granted, free of charge, to any person obtaining a
919N/A# copy of this software and associated documentation files (the "Software"),
919N/A# to deal in the Software without restriction, including without limitation
919N/A# the rights to use, copy, modify, merge, publish, distribute, sublicense,
919N/A# and/or sell copies of the Software, and to permit persons to whom the
919N/A# Software is furnished to do so, subject to the following conditions:
919N/A#
919N/A# The above copyright notice and this permission notice (including the next
919N/A# paragraph) shall be included in all copies or substantial portions of the
919N/A# Software.
919N/A#
919N/A# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
919N/A# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
919N/A# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
919N/A# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
919N/A# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
919N/A# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
919N/A# DEALINGS IN THE SOFTWARE.
40N/A#
40N/A#
40N/A
40N/A# Updates manual pages to include standard Sun man page sections
40N/A#
947N/A# Arguments:
947N/A# -a '{attribute, value}, ...' - add entries to Attributes section table
947N/A# -o '{attribute, value}, ...' - override previous entries in
947N/A# Attributes section table
40N/A# -l libname - add library line to synopsis
47N/A# -p path - add path to command in synopsis
1003N/A# -r '{text, replacement}' - replace text with replacement
40N/A
493N/Ause Getopt::Long;
40N/Ause integer;
40N/Ause strict;
40N/A
493N/Amy @attributes;
947N/Amy @overrides;
1003N/Amy @replacements;
493N/Amy $library;
493N/Amy $synpath;
493N/A
493N/Amy $result = GetOptions('a|attribute=s' => \@attributes,
947N/A 'o|override=s' => \@overrides,
1003N/A 'r|replace=s' => \@replacements,
493N/A 'l|library=s' => \$library,
493N/A 'p|path=s' => \$synpath);
40N/A
40N/Amy $add_attributes = 0;
1003N/Amy $attributes_table;
40N/A
947N/Aif (scalar(@attributes) + scalar(@overrides) > 0) {
40N/A $add_attributes = 1;
1003N/A $attributes_table = &get_attributes_table(\@attributes, \@overrides);
1003N/A}
1003N/A
1003N/A# Reference to generated function to substitute text replacements
1003N/Amy $text_subref;
1003N/A
1003N/Aif (scalar(@replacements) > 0) {
1003N/A $text_subref = &get_text_substitutions(\@replacements);
40N/A}
40N/A
40N/Amy $add_library_to_synopsis = 0;
40N/A
493N/Aif (defined($library)) {
40N/A $add_library_to_synopsis = 1;
40N/A}
40N/A
47N/Amy $add_path_to_synopsis = 0;
47N/A
493N/Aif (defined($synpath)) {
47N/A $add_path_to_synopsis = 1;
47N/A}
47N/A
40N/Amy $filename;
40N/A
40N/Awhile ($filename = shift) {
947N/A rename($filename, "$filename.orig")
947N/A || die "Cannot rename $filename to $filename.orig: $!";
947N/A open(IN, '<', "$filename.orig")
947N/A || die "Cannot read $filename.orig: $!";
947N/A open(OUT, '>', $filename)
947N/A || die "Cannot write to $filename: $!";
40N/A
40N/A my $firstline = <IN>;
40N/A
493N/A if ($add_attributes > 0) {
40N/A # Check for man page preprocessor list - if found, make sure t is in it for
40N/A # table processing, if not found, add one;
40N/A
40N/A if ($firstline =~ m/\'\\\"/) {
40N/A # Found preprocessor list
40N/A if ($firstline =~ m/t/) {
40N/A # Do nothing - tbl preprocessing already selected
40N/A } else {
40N/A chomp($firstline);
40N/A $firstline .= "t\n";
40N/A }
40N/A } else {
40N/A # No preprocessor list found
40N/A print OUT q('\" t), "\n";
40N/A }
40N/A }
40N/A
40N/A print OUT $firstline;
40N/A
40N/A my $nextline;
40N/A while ($nextline = <IN>) {
1003N/A if ($text_subref) {
1003N/A $nextline = &$text_subref($nextline);
1003N/A }
40N/A print OUT $nextline;
40N/A
70N/A if ($nextline =~ m/.SH[\s "]*(SYNOPSIS|SYNTAX)/) {
47N/A if ($add_library_to_synopsis) {
40N/A print OUT ".nf\n",
40N/A q(\fBcc\fR [ \fIflag\fR\&.\&.\&. ] \fIfile\fR\&.\&.\&. \fB\-l),
40N/A $library, q(\fR [ \fIlibrary\fR\&.\&.\&. ]), "\n.fi\n";
40N/A }
47N/A elsif ($add_path_to_synopsis) {
47N/A $nextline = <IN>;
47N/A $nextline =~ s/^(\.B[IR]*\s+\"?)/$1$synpath/;
90N/A $nextline =~ s/^(\\fB)/$1$synpath/;
47N/A print OUT $nextline;
47N/A }
40N/A }
40N/A }
40N/A
40N/A if ($add_attributes) {
1003N/A print OUT $attributes_table;
40N/A }
40N/A
40N/A close(IN);
40N/A close(OUT);
40N/A}
40N/A
40N/A
40N/Asub get_attributes_table {
947N/A my ($attributes_ref, $overrides_ref) = @_;
40N/A
40N/A my $attributes_table = q{
40N/A.\\" Begin Sun update
40N/A.SH "ATTRIBUTES"
40N/ASee \fBattributes\fR(5) for descriptions of the following attributes:
40N/A.sp
40N/A.TS
40N/Aallbox;
40N/Acw(2.750000i)| cw(2.750000i)
40N/Alw(2.750000i)| lw(2.750000i).
40N/AATTRIBUTE TYPE ATTRIBUTE VALUE
40N/A<attributes>
947N/A.TE
40N/A.sp
40N/A.\\" End Sun update
40N/A};
40N/A
40N/A my $attribute_entries = "";
40N/A
947N/A my @attribute_pairs = parse_attributes_list($attributes_ref);
947N/A my @overrides_pairs = parse_attributes_list($overrides_ref);
947N/A
947N/A foreach my $o (@overrides_pairs) {
947N/A my ($oname, $ovalue) = @{$o};
947N/A my $found_match = 0;
493N/A
947N/A foreach my $a (@attribute_pairs) {
947N/A if ($a->[0] eq $oname) {
947N/A $a->[1] = $ovalue;
947N/A $found_match++;
947N/A }
947N/A }
947N/A
947N/A if ($found_match == 0) {
947N/A push @attribute_pairs, $o;
947N/A }
947N/A }
947N/A
947N/A foreach my $a (@attribute_pairs) {
947N/A my ($name, $value) = @{$a};
40N/A $attribute_entries .= $name . "\t" . $value . "\n";
40N/A }
493N/A
40N/A $attributes_table =~ s/<attributes>\n/$attribute_entries/;
40N/A
40N/A return $attributes_table;
40N/A}
947N/A
947N/Asub parse_attributes_list {
947N/A my ($list_ref) = @_;
947N/A
947N/A my $list_string = join(" ", @{$list_ref});
947N/A $list_string =~ s/^\s*{//;
947N/A $list_string =~ s/}\s*$//;
947N/A
947N/A my @attribs = split /}\s*{/, $list_string;
947N/A my @attrib_pairs = ();
947N/A
947N/A foreach my $a (@attribs) {
947N/A my @pair = split /,\s*/, $a, 2; # pair = name, value
947N/A push @attrib_pairs, \@pair;
947N/A }
947N/A return @attrib_pairs;
947N/A}
1003N/A
1003N/Asub get_text_substitutions {
1003N/A my ($replacements_ref) = @_;
1003N/A
1003N/A my @replacement_pairs = parse_attributes_list($replacements_ref);
1003N/A
1003N/A my @subst_pattern_list = ();
1003N/A
1003N/A foreach my $r (@replacement_pairs) {
1003N/A my ($text_in, $text_out) = @{$r};
1003N/A push @subst_pattern_list, " s{$text_in}{$text_out}go;";
1003N/A }
1003N/A
1003N/A my $subst_function = join("\n",
1003N/A 'sub {',
1003N/A ' $_ = $_[0]; ',
1003N/A @subst_pattern_list,
1003N/A ' return $_;',
1003N/A '}');
1003N/A
1003N/A print $subst_function;
1003N/A
1003N/A return eval $subst_function;
1003N/A}