generic-autogen

#!/usr/bin/perl

# Generic .xml generator
# Currently builds glossary or howtos.
# Invoke as: bin/generic-autogen NAME
# (It creates NAME/NAME.xml with files from NAME/*)

use warnings;
use strict;

my %items;
my %alphabet;
my $verbose = 0;
my $cat = shift; $cat ||= "glossary";
my @loaded;
my $document;
my %sn = ( # short name
	glossary => "glos",
	howtos => "howto",
);
my %ln = ( # long name
	glossary => "glossary entry",
	howtos => "HOW-TO",
);

my %header = ( # item head
	glossary => "<glossentry id=\"\$file\">
<glossterm>\$file</glossterm>

<glossdef><para>
",
);
my %footer = ( # item tail
	glossary => "\n</para>\n</glossdef>\n</glossentry>\n\n",
);

# HEAD
my $glossary = <<__ENDP__;
<?xml version="1.0" standalone="no"?>

<!DOCTYPE glossary PUBLIC "-//OASIS//DTD DocBook-Interchange XML V4.2//EN"
  "../docbook/docbookxi.dtd">

<glossary>
	<title>Interchange Documentation: Glossary</title>

__ENDP__
my $howtos = <<__ENDP__;
<?xml version="1.0" standalone="no"?>

<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook-Interchange XML V4.2//EN"
  "../docbook/docbookxi.dtd">

<book id="howtos">

	<bookinfo>

		<title>Interchange HOWTOs collection</title>
		<titleabbrev>howtos</titleabbrev>

		<legalnotice>
			<para>
			Copyright (C) 2004, Interchange Development Group
			</para>
			<para>
			This documentation is free; you can redistribute it and/or modify
			it under the terms of the GNU General Public License as published by
			the Free Software Foundation; either version 2 of the License, or
			(at your option) any later version.
			</para>
			<para>
			It is distributed in the hope that it will be useful,
			but WITHOUT ANY WARRANTY; without even the implied warranty of
			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
			GNU General Public License for more details.
			</para>
		</legalnotice>

	</bookinfo>

	<!--
	<preface>
		<title>Foreword</title>
		<para></para>
	</preface>
	-->
__ENDP__

# OPEN GLOSSARY ENTITIES
print "GEN: docbook/auto$cat.ent\n";
open ENT, "> docbook/auto$cat.ent" or
	die "Can't wropen docbook/$cat.ent ($!)\n";

# LOAD ITEMS
opendir DIR, $cat or die "Can't open $cat/ ($!)\n";
readdir DIR; readdir DIR;

# Read all elements from a directory
while ( my $file = readdir DIR ) {
	next if $file =~ /^\.|^CVS|\.xml$/;
	open IN, "< $cat/$file" or die "Can't read-open $cat/$file ($!)\n";
	$items{$file} = [ prefix($cat, $file), <IN>, suffix($cat, $file) ];
	$alphabet{ lc(substr($file, 0, 1)) }++;
	push @loaded, $file;

	my $lcfile = lc $file;
	my $link = "<olink targetdoc='$cat' targetptr='$file'/>";
	my $more = $cat eq 'howtos' ? " $ln{$cat}" : "";

	print ENT <<ENDO;
<!ENTITY $sn{$cat}-$file "$link$more">
ENDO
	print "Added $file\n" if $verbose;

	close IN or warn "Error closing $cat/$file ($!)\n";
}
closedir DIR or warn "Error closing $cat/ ($!)\n";


# ADD ITEMS TO HEAD  (TYPE-SPECIFIC)
if ( $cat eq 'glossary' ) {
	$document = $glossary;
	for my $letter ( sort keys %alphabet ) {
		next unless $alphabet{$letter}; # Next if no entries on that letter
		print "Passed on $letter\n" if $verbose;

		$document .= '<glossdiv><title>' . uc($letter) . '</title>' . "\n";

		my @keys = sort grep {/^$letter/i} keys %items;
		for my $key ( @keys ) {
			print "FOUND KEY $key\n" if $verbose;
			$document .= join "", @{ $items{$key} };
		}
		$document .= '</glossdiv>' . "\n";
	}
	$document .= '</glossary>';

} elsif ( $cat eq 'howtos' ) {
	$document = $howtos;
	for my $howto ( @loaded ) { # order is as on filesystem
		print "Processing $howto\n" if $verbose;
		$document .= join "", @{ $items{$howto} };
	}
	$document .= '</book>';
}


# SAVE OUT
print "GEN: $cat/$cat.xml\n";
open OUT, "> $cat/$cat.xml" or
die "Can't wropen $cat/$cat.xml ($!)\n";
print OUT $document;
close OUT or warn "Cant close $cat/$cat.xml ($!)\n";

exit 0;

################################################################
# Helpers below

sub prefix {
	my ($cat, $file) = @_;
	if ( $header{$cat} ) {
		my $tmp = $header{$cat};
		$tmp =~ s/(\$\w+)/$1/gee;
		return $tmp;
	}
	""
}

sub suffix {
	my ($cat, $file) = @_;
	if ( $footer{$cat} ) {
		my $tmp = $footer{$cat};
		$tmp =~ s/(\$\w+)/$1/gee;
		return $tmp;
	}
	""
}