html2db

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # html2db
   5 # File ID: 2aad61e8-f743-11dd-8708-000475e441b9
   6 # Simple HTML to DocBook conversion utility.
   7 #
   8 # Character set: UTF-8
   9 # ©opyleft 2004– Øyvind A. Holm <sunny@sunbase.org>
  10 # License: GNU General Public License version 2 or later, see end of
  11 # file for legal stuff.
  12 #=======================================================================
  13
  14 use strict;
  15 use warnings;
  16 use Getopt::Long;
  17
  18 $| = 1;
  19
  20 our $Debug = 0;
  21
  22 our %Opt = (
  23
  24     'debug' => 0,
  25     'help' => 0,
  26     'verbose' => 0,
  27     'version' => 0,
  28
  29 );
  30 my $Warn = "<!-- \@html2db -->";
  31
  32 our $progname = $0;
  33 $progname =~ s/^.*\/(.*?)$/$1/;
  34 our $VERSION = "0.00";
  35
  36 Getopt::Long::Configure("bundling");
  37 GetOptions(
  38
  39     "debug" => \$Opt{'debug'},
  40     "help|h" => \$Opt{'help'},
  41     "verbose|v+" => \$Opt{'verbose'},
  42     "version" => \$Opt{'version'},
  43
  44 ) || die("$progname: Option error. Use -h for help.\n");
  45
  46 $Opt{'debug'} && ($Debug = 1);
  47 $Opt{'help'} && usage(0);
  48 if ($Opt{'version'}) {
  49     print_version();
  50     exit(0);
  51 }
  52
  53 my $Orig = join("", <>);
  54 my $Data = $Orig;
  55 my $H1_kludge = "<h1>This is just a placeholder by html2db. It should not be here.</h1>";
  56
  57 if ($Data =~ m#</body\b#s) {
  58     $Data =~ s#</body\b(.*?)$#$H1_kludge</body$1#s;
  59 } else {
  60     $Data .= $H1_kludge;
  61 }
  62
  63 $Data =~ s#<!DOCTYPE .*?>#<!DOCTYPE article PUBLIC "-//OASIS//DTD DocBook XML V4//EN" "http://docbook.org/xml/4.3/docbookx.dtd">#s;
  64 $Data = conv_elem("html", "article", $Data);
  65 $Data = conv_elem("head", "articleinfo", $Data);
  66 $Data = conv_elem("em", "emphasis", $Data);
  67 $Data = conv_elem("samp", "computeroutput", $Data);
  68 $Data = conv_elem("code", "filename", $Data, 1);
  69 $Data = conv_elem("kbd", "command", $Data);
  70 $Data = conv_elem("p", "para", $Data);
  71 $Data = conv_elem("ul", "itemizedlist", $Data);
  72 $Data = conv_elem("ol", "orderedlist", $Data);
  73 $Data = conv_elem("li", "listitem", $Data, 0, 1);
  74 $Data = conv_elem("dl", "variablelist", $Data);
  75 $Data = conv_elem("dt", "term", $Data);
  76 $Data = conv_elem("dd", "listitem", $Data, 0, 1);
  77 $Data = conv_elem("pre", "screen", $Data);
  78 $Data = conv_h(6, $Data);
  79 $Data = conv_h(5, $Data);
  80 $Data = conv_h(4, $Data);
  81 $Data = conv_h(3, $Data);
  82 $Data = conv_h(2, $Data);
  83 $Data = conv_h(1, $Data);
  84
  85 $Data =~ s#<a\s+href="(.*?)">(.+?)</a>#<ulink url="$1">$2</ulink>#gs;
  86
  87 D("\$Data before cleanup \x7B\x7B\x7B\n$Data\n\x7D\x7D\x7D");
  88
  89 $Data =~ s/$H1_kludge//;
  90
  91 print($Data);
  92
  93 sub conv_elem {
  94     # {{{
  95     my ($From, $To, $Str, $Check, $InsPara) = @_;
  96     defined($Check) || ($Check = 0);
  97     defined($InsPara) || ($InsPara = 0);
  98     my $chk_str = $Check ? "$Warn" : "";
  99     my ($Par1, $Par2) =
 100        (   "",    "");
 101     if ($InsPara) {
 102         $Par1 = "<para>";
 103         $Par2 = "</para>";
 104     }
 105
 106     $Str =~
 107     s{
 108         <$From\b(.*?)>(.*?)</$From\b(.*?)>
 109     }
 110     {
 111         my ($Attrib, $Txt, $SubAttr) =
 112            (     $1,   $2,       $3);
 113         D("Er i regexp");
 114         $Attrib =~ s/^\s*(.*?)\s*$/$1/s;
 115         length($Attrib) && ($Attrib = " $Attrib", $chk_str = $Warn);
 116         "$chk_str<$To$Attrib>$Par1$Txt$Par2</$To>";
 117     }gsex;
 118     return($Str);
 119     # }}}
 120 }
 121
 122 sub conv_h {
 123     # {{{
 124     my ($Level, $Str) = @_;
 125     my $end_head = "";
 126
 127     for (my $Tmp = $Level; $Tmp >= 1; $Tmp--) {
 128         $end_head .= $Tmp;
 129     }
 130     my $reg_str = <<END;
 131         <(h$Level)\\b(.*?)>
 132         (.*?)
 133         </h$Level\\b(.*?)>
 134         (.*?)
 135         <(h[$end_head])\\b(.*?)>
 136 END
 137     D("reg_str = \x7B\x7B\x7B\n$reg_str\n\x7D\x7D\x7D");
 138     $Str =~
 139     s{
 140         $reg_str
 141     }
 142     {
 143         my ($Elem1, $Attrib, $Header, $SubAttr1, $Txt, $Elem2, $SubAttr2) =
 144            (     $1,     $2,      $3,        $4,   $5,     $6,        $7);
 145         D("conv_h(): Er i regexp");
 146         $Attrib =~ s/^\s*(.*?)\s*$/$1/s;
 147         length($Attrib) && ($Attrib = " $Warn $Attrib");
 148         "<sect$Level$Attrib> <title>$Header</title>\n$Txt\n</sect$Level>\n<$Elem2$SubAttr2>";
 149     }gsex;
 150     return($Str);
 151     # }}}
 152 }
 153
 154 sub print_version {
 155     # Print program version {{{
 156     print("$progname v$VERSION\n");
 157     # }}}
 158 } # print_version()
 159
 160 sub usage {
 161     # Send the help message to stdout {{{
 162     my $Retval = shift;
 163
 164     if ($Opt{'verbose'}) {
 165         print("\n");
 166         print_version();
 167     }
 168     print(<<END);
 169
 170 Usage: $progname [options] [file [files [...]]]
 171
 172 Experimental script for converting XHTML to DocBook.
 173
 174 To get all the headers converted, the files have to be filtered through
 175 the script several times. And there will probably be some <hX> headers
 176 which needs manual conversion. The curse of <h?> elements.
 177
 178 Options:
 179
 180   -h, --help
 181     Show this help.
 182   -v, --verbose
 183     Increase level of verbosity. Can be repeated.
 184   --version
 185     Print version information.
 186   --debug
 187     Print debugging messages.
 188
 189 END
 190     exit($Retval);
 191     # }}}
 192 } # usage()
 193
 194 sub msg {
 195     # Print a status message to stderr based on verbosity level {{{
 196     my ($verbose_level, $Txt) = @_;
 197
 198     if ($Opt{'verbose'} >= $verbose_level) {
 199         print(STDERR "$progname: $Txt\n");
 200     }
 201     # }}}
 202 } # msg()
 203
 204 sub D {
 205     # Print a debugging message {{{
 206     $Debug || return;
 207     my @call_info = caller;
 208     chomp(my $Txt = shift);
 209     my $File = $call_info[1];
 210     $File =~ s#\\#/#g;
 211     $File =~ s#^.*/(.*?)$#$1#;
 212     print(STDERR "$File:$call_info[2] $$ $Txt\n");
 213     return("");
 214     # }}}
 215 } # D()
 216
 217 __END__
 218
 219 # Plain Old Documentation (POD) {{{
 220
 221 =pod
 222
 223 =head1 NAME
 224
 225
 226
 227 =head1 SYNOPSIS
 228
 229  [options] [file [files [...]]]
 230
 231 =head1 DESCRIPTION
 232
 233
 234
 235 =head1 OPTIONS
 236
 237 =over 4
 238
 239 =item B<-h>, B<--help>
 240
 241 Print a brief help summary.
 242
 243 =item B<-v>, B<--verbose>
 244
 245 Increase level of verbosity. Can be repeated.
 246
 247 =item B<--version>
 248
 249 Print version information.
 250
 251 =item B<--debug>
 252
 253 Print debugging messages.
 254
 255 =back
 256
 257 =head1 BUGS
 258
 259
 260
 261 =head1 AUTHOR
 262
 263 Made by Øyvind A. Holm S<E<lt>sunny@sunbase.orgE<gt>>.
 264
 265 =head1 COPYRIGHT
 266
 267 Copyleft © Øyvind A. Holm E<lt>sunny@sunbase.orgE<gt>
 268 This is free software; see the file F<COPYING> for legalese stuff.
 269
 270 =head1 LICENCE
 271
 272 This program is free software: you can redistribute it and/or modify it
 273 under the terms of the GNU General Public License as published by the
 274 Free Software Foundation, either version 2 of the License, or (at your
 275 option) any later version.
 276
 277 This program is distributed in the hope that it will be useful, but
 278 WITHOUT ANY WARRANTY; without even the implied warranty of
 279 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 280 See the GNU General Public License for more details.
 281
 282 You should have received a copy of the GNU General Public License along
 283 with this program.
 284 If not, see L<http://www.gnu.org/licenses/>.
 285
 286 =head1 SEE ALSO
 287
 288 =cut
 289
 290 # }}}
 291
 292 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :