manual/build/preseed.pl

#!/usr/bin/perl -w

# Script parses the XML file for the appendix on preseeding and extracts
# example snippts to form the raw preseed example file. Section titles are
# added as headers.
# The script will include all text between <informalexample> tags that have
# the attribute 'role="example"' set, except if a 'condition' attribute is
# in force that does not match the specified release or if an 'arch' attribute
# is in force that does not match the specified architecture.

# Define module to use
use HTML::Parser();
use Getopt::Std;

local %tagstatus;
local %example;
local %ignore;
local $prevtag = '';
local $titletag;
local $settitle = 0;

$example{'print'} = 0;
$example{'in_sect'} = 0;
$example{'first'} = 1;
$example{'new'} = 0;

getopts('hda:r:') || die "Unknown command line arguments! Try $0 -h\n";
use vars qw($opt_h $opt_d $opt_a $opt_r);

if ($opt_h) {
        print <<END;
preseed.pl: parses preseed appendix xml file to extract preseed example file

Usage: $0 [-hdac] <xml-file>

Options:
        -h              display this help information
        -d              debug mode
        -a <arch>       architecture for which to generate the example
                        (default: i386)
        -r <release>    release for which to generate the example (required)
END
        exit 0;
}

die "Must specify release for which to generate example.\n" if ! $opt_r;

my $xmlfile = shift;
die "Must specify XML file to parse!\n" if ! $xmlfile;
die "Specified XML file \"$xmlfile\" not found.\n" if ! -f $xmlfile;

my $arch = $opt_a ? "$opt_a" : "i386";
my $release = $opt_r;


# Create instance
$p = HTML::Parser->new(
        start_h => [\&start_rtn, 'tagname, text, attr'],
        text_h => [\&text_rtn, 'text'],
        end_h => [\&end_rtn, 'tagname']);

# Start parsing the specified file
$p->parse_file($xmlfile);

# Replace entities in examples
# FIXME: should maybe be extracted from entity definition
sub replace_entities {
        my ($text) = @_;

        $text =~ s/&archive-mirror;/http.us.debian.org/;
        $text =~ s/&releasename;/$release/;

        # Any unrecognized entities?
        if ( $text =~ /&[^ ]+;/ ) {
                my ($ent) = $text =~ m/.*(&[^ ]+;).*/;
                die "Error: unrecognized entity '$ent'\n"
        }

        return $text;
}

# Execute when start tag is encountered
sub start_rtn {
        my ($tagname, $text, $attr) = @_;
        print STDERR "\nStart: $tagname\n" if $opt_d;

        if ( $tagname =~ /appendix|sect1|sect2|sect3|para|informalexample|phrase/ ) {
                $tagstatus{$tagname}{'count'} += 1;
                print STDERR "$tagname  $tagstatus{$tagname}{'count'}\n" if $opt_d;

                if ( ! exists $ignore{'tag'} ) {
                        # FIXME: this ignores that 'contition' is used for many
                        # other things than the release; should be OK in practice
                        # for the preseed appendix though.
                        if ( exists $attr->{condition} ) {
                                print STDERR "Condition: $attr->{condition}\n" if $opt_d;
                                if ( $attr->{condition} ne $release ) {
                                        $ignore{'tag'} = $tagname;
                                        $ignore{'depth'} = $tagstatus{$tagname}{'count'};
                                        print STDERR "Start ignore because of condition" if $opt_d;
                                }
                        }
                        if ( exists $attr->{arch} ) {
                                print STDERR "Architecture: $attr->{arch}\n" if $opt_d;
                                if ( $attr->{arch} ne $arch ) {
                                        $ignore{'tag'} = $tagname;
                                        $ignore{'depth'} = $tagstatus{$tagname}{'count'};
                                        print STDERR "Start ignore because of architecture" if $opt_d;
                                }
                        }
                }
        }

        # Assumes that <title> is the first tag after a section tag
        if ( $prevtag =~ /sect1|sect2|sect3/ ) {
                $settitle = ( $tagname eq 'title' );
                $titletag = $prevtag;
                $example{'in_sect'} = 0;
        }
        $prevtag = $tagname;
        if ( $tagname eq 'informalexample' && ! exists $ignore{'tag'} ) {
                if ( exists $attr->{role} && $attr->{role} eq "example" ) {
                        $example{'print'} = 1;
                        $example{'new'} = 1;
                }
        }
}
 
# Execute when text is encountered
sub text_rtn {
        my ($text) = @_;

        if ( $settitle ) {
                # Clean leading and trailing whitespace for titles
                $text =~ s/^[[:space:]]*//;
                $text =~ s/[[:space:]]*$//;

                $text = replace_entities($text);
                $tagstatus{$titletag}{'title'} = $text;
                $settitle = 0;
        }

        if ( $example{'print'} && ! exists $ignore{'tag'} ) {
                # Print section headers
                for ($s=1; $s<=3; $s++) {
                        my $sect="sect$s";
                        if ( $tagstatus{$sect}{'title'} ) {
                                print "\n" if ( $s == 1 && ! $example{'first'} );
                                for ( $i = 1; $i <= 5 - $s; $i++ ) { print "#"; };
                                print " $tagstatus{$sect}{'title'}\n";
                                delete $tagstatus{$sect}{'title'};
                        }
                }

                # Clean leading whitespace
                if ( $example{'new'} ) {
                        $text =~ s/^[[:space:]]*//;
                }

                $text = replace_entities($text);
                print "$text";

                $example{'first'} = 0;
                $example{'new'} = 0;
                $example{'in_sect'} = 1;
        }
}

# Execute when the end tag is encountered
sub end_rtn {
        my ($tagname) = @_;
        print STDERR "\nEnd: $tagname\n" if $opt_d;

        # Set of tags must match what's in start_rtn
        if ( $tagname =~ /appendix|sect1|sect2|sect3|para|informalexample|phrase/ ) {
                my $ts = $tagstatus{$tagname}{'count'};
                $tagstatus{$tagname}{'count'} -= 1;
                print STDERR "$tagname  $tagstatus{$tagname}{'count'}\n" if $opt_d;
                die "Invalid XML file: negative count for tag <$tagname>!\n" if $tagstatus{$tagname}{'count'} < 0;

                if ( exists $ignore{'tag'} ) {
                        if ( $ignore{'tag'} eq $tagname && $ignore{'depth'} == $ts ) {
                                delete $ignore{'tag'};
                        }
                        return
                }
        }

        if ( $tagname eq 'informalexample' ) {
                $example{'print'} = 0;
        }

        if ( $tagname =~ /appendix|sect1|sect2|sect3|para/ ) {
                delete $tagstatus{$tagname}{'title'} if exists $tagstatus{$tagname}{'title'};

                if ( $example{'in_sect'} ) {
                        print "\n";
                        $example{'in_sect'} = 0;
                }
        }
}
1	fjp	32347	#!/usr/bin/perl -w
2
3	fjp	32412	# Script parses the XML file for the appendix on preseeding and extracts
4			# example snippts to form the raw preseed example file. Section titles are
5			# added as headers.
6	fjp	32416	# The script will include all text between <informalexample> tags that have
7			# the attribute 'role="example"' set, except if a 'condition' attribute is
8			# in force that does not match the specified release or if an 'arch' attribute
9			# is in force that does not match the specified architecture.
10	fjp	32412
11	fjp	32347	# Define module to use
12	fjp	32358	use HTML::Parser();
13	fjp	32412	use Getopt::Std;
14	fjp	32347
15			local %tagstatus;
16	fjp	32358	local %example;
17	fjp	32412	local %ignore;
18			local $prevtag = '';
19			local $titletag;
20			local $settitle = 0;
21	fjp	32347
22	fjp	32358	$example{'print'} = 0;
23			$example{'in_sect'} = 0;
24			$example{'first'} = 1;
25			$example{'new'} = 0;
26
27	fjp	32412	getopts('hda:r:') \|\| die "Unknown command line arguments! Try $0 -h\n";
28			use vars qw($opt_h $opt_d $opt_a $opt_r);
29
30			if ($opt_h) {
31			print <<END;
32			preseed.pl: parses preseed appendix xml file to extract preseed example file
33
34			Usage: $0 [-hdac] <xml-file>
35
36			Options:
37			-h display this help information
38			-d debug mode
39			-a <arch> architecture for which to generate the example
40			(default: i386)
41			-r <release> release for which to generate the example (required)
42			END
43			exit 0;
44			}
45
46	fjp	58175	die "Must specify release for which to generate example.\n" if ! $opt_r;
47	fjp	32412
48			my $xmlfile = shift;
49	fjp	58175	die "Must specify XML file to parse!\n" if ! $xmlfile;
50			die "Specified XML file \"$xmlfile\" not found.\n" if ! -f $xmlfile;
51	fjp	32412
52			my $arch = $opt_a ? "$opt_a" : "i386";
53			my $release = $opt_r;
54
55
56	fjp	32358	# Create instance
57			$p = HTML::Parser->new(
58			start_h => [\&start_rtn, 'tagname, text, attr'],
59			text_h => [\&text_rtn, 'text'],
60			end_h => [\&end_rtn, 'tagname']);
61	fjp	32412
62			# Start parsing the specified file
63			$p->parse_file($xmlfile);
64
65	fjp	58175	# Replace entities in examples
66			# FIXME: should maybe be extracted from entity definition
67			sub replace_entities {
68			my ($text) = @_;
69
70			$text =~ s/&archive-mirror;/http.us.debian.org/;
71			$text =~ s/&releasename;/$release/;
72
73			# Any unrecognized entities?
74			if ( $text =~ /&[^ ]+;/ ) {
75			my ($ent) = $text =~ m/.(&[^ ]+;)./;
76			die "Error: unrecognized entity '$ent'\n"
77			}
78
79			return $text;
80			}
81
82	fjp	32358	# Execute when start tag is encountered
83			sub start_rtn {
84			my ($tagname, $text, $attr) = @_;
85	fjp	32412	print STDERR "\nStart: $tagname\n" if $opt_d;
86	fjp	58174
87			if ( $tagname =~ /appendix\|sect1\|sect2\|sect3\|para\|informalexample\|phrase/ ) {
88	fjp	32358	$tagstatus{$tagname}{'count'} += 1;
89	fjp	32412	print STDERR "$tagname $tagstatus{$tagname}{'count'}\n" if $opt_d;
90
91			if ( ! exists $ignore{'tag'} ) {
92	fjp	58174	# FIXME: this ignores that 'contition' is used for many
93			# other things than the release; should be OK in practice
94			# for the preseed appendix though.
95	fjp	32412	if ( exists $attr->{condition} ) {
96			print STDERR "Condition: $attr->{condition}\n" if $opt_d;
97			if ( $attr->{condition} ne $release ) {
98			$ignore{'tag'} = $tagname;
99			$ignore{'depth'} = $tagstatus{$tagname}{'count'};
100			print STDERR "Start ignore because of condition" if $opt_d;
101			}
102			}
103			if ( exists $attr->{arch} ) {
104			print STDERR "Architecture: $attr->{arch}\n" if $opt_d;
105			if ( $attr->{arch} ne $arch ) {
106			$ignore{'tag'} = $tagname;
107			$ignore{'depth'} = $tagstatus{$tagname}{'count'};
108			print STDERR "Start ignore because of architecture" if $opt_d;
109			}
110			}
111			}
112	fjp	32358	}
113	fjp	58174
114	fjp	32358	# Assumes that <title> is the first tag after a section tag
115			if ( $prevtag =~ /sect1\|sect2\|sect3/ ) {
116			$settitle = ( $tagname eq 'title' );
117			$titletag = $prevtag;
118			$example{'in_sect'} = 0;
119			}
120			$prevtag = $tagname;
121	fjp	32412	if ( $tagname eq 'informalexample' && ! exists $ignore{'tag'} ) {
122	fjp	32416	if ( exists $attr->{role} && $attr->{role} eq "example" ) {
123			$example{'print'} = 1;
124			$example{'new'} = 1;
125			}
126	fjp	32358	}
127			}
128	fjp	32347
129	fjp	32358	# Execute when text is encountered
130			sub text_rtn {
131	fjp	32412	my ($text) = @_;
132	fjp	58176
133	fjp	32358	if ( $settitle ) {
134	fjp	32412	# Clean leading and trailing whitespace for titles
135			$text =~ s/^[[:space:]]*//;
136			$text =~ s/[[:space:]]*$//;
137	fjp	58175
138			$text = replace_entities($text);
139	fjp	32358	$tagstatus{$titletag}{'title'} = $text;
140			$settitle = 0;
141			}
142	fjp	58176
143			if ( $example{'print'} && ! exists $ignore{'tag'} ) {
144	fjp	32358	# Print section headers
145			for ($s=1; $s<=3; $s++) {
146			my $sect="sect$s";
147			if ( $tagstatus{$sect}{'title'} ) {
148			print "\n" if ( $s == 1 && ! $example{'first'} );
149			for ( $i = 1; $i <= 5 - $s; $i++ ) { print "#"; };
150			print " $tagstatus{$sect}{'title'}\n";
151			delete $tagstatus{$sect}{'title'};
152			}
153	fjp	32347	}
154	fjp	32358
155			# Clean leading whitespace
156			if ( $example{'new'} ) {
157			$text =~ s/^[[:space:]]*//;
158			}
159
160	fjp	58175	$text = replace_entities($text);
161	fjp	32358	print "$text";
162
163			$example{'first'} = 0;
164			$example{'new'} = 0;
165			$example{'in_sect'} = 1;
166	fjp	32347	}
167	fjp	32358	}
168	fjp	32412
169	fjp	32358	# Execute when the end tag is encountered
170			sub end_rtn {
171			my ($tagname) = @_;
172	fjp	32412	print STDERR "\nEnd: $tagname\n" if $opt_d;
173	fjp	58174
174			# Set of tags must match what's in start_rtn
175			if ( $tagname =~ /appendix\|sect1\|sect2\|sect3\|para\|informalexample\|phrase/ ) {
176			my $ts = $tagstatus{$tagname}{'count'};
177			$tagstatus{$tagname}{'count'} -= 1;
178			print STDERR "$tagname $tagstatus{$tagname}{'count'}\n" if $opt_d;
179	fjp	58175	die "Invalid XML file: negative count for tag <$tagname>!\n" if $tagstatus{$tagname}{'count'} < 0;
180	fjp	58174
181			if ( exists $ignore{'tag'} ) {
182			if ( $ignore{'tag'} eq $tagname && $ignore{'depth'} == $ts ) {
183			delete $ignore{'tag'};
184			}
185			return
186			}
187			}
188
189	fjp	32358	if ( $tagname eq 'informalexample' ) {
190			$example{'print'} = 0;
191	fjp	32347	}
192	fjp	58174
193	fjp	32358	if ( $tagname =~ /appendix\|sect1\|sect2\|sect3\|para/ ) {
194			delete $tagstatus{$tagname}{'title'} if exists $tagstatus{$tagname}{'title'};
195	fjp	32412
196	fjp	32358	if ( $example{'in_sect'} ) {
197			print "\n";
198			$example{'in_sect'} = 0;
199			}
200			}
201			}