Setup of Perl scripts for making FAQ
This commit is contained in:
hailer
parent
7fbe898f83
commit
2ae61ad53e
|
|
@ -0,0 +1,717 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# Creates 7 bit ASCII text from Latin-1 FAQ
|
||||
#
|
||||
# (c) 1996 Volker Götz <volker@oops.franken.de>
|
||||
# modified 1996/1997 by
|
||||
# Bernhard Hailer <dl4mhk@lrz.uni-muenchen.de>
|
||||
# Matthias Heßler <hessler@wi-inf.uni-essen.de>
|
||||
#
|
||||
# $Id: 7bit.pl,v 1.1 1997/02/19 19:54:50 hailer Exp $
|
||||
|
||||
|
||||
#
|
||||
# Variables
|
||||
#
|
||||
|
||||
# Unbuffered print's
|
||||
$| = 1;
|
||||
|
||||
$margin = 6;
|
||||
$bar = "| ";
|
||||
$barlen = length ($bar);
|
||||
# maxlen gibt an, wieviele Zeichen max. pro Zeile ausgegeben werden
|
||||
# (margin geht extra...)
|
||||
$maxlen = 79 - $margin;
|
||||
|
||||
# Für die Datenausgabe benötigt...
|
||||
$actline = "";
|
||||
$commentline = "";
|
||||
$lastnumber = "";
|
||||
|
||||
# Für Änderungsstrich (default: Änderungsstrich!)
|
||||
$old = 0;
|
||||
|
||||
# Fragenzaehler
|
||||
$maincount = 0;
|
||||
$subcount = 0;
|
||||
$qcount = 0;
|
||||
|
||||
# Statusvariable
|
||||
$script = "FALSE";
|
||||
$state = "begin";
|
||||
$buffer = "-";
|
||||
|
||||
|
||||
#
|
||||
# Get file names from prompt
|
||||
#
|
||||
|
||||
$in = $ARGV[0];
|
||||
die "Usage: 7bit.pl infile [outfile] [headtempfile] [tailtempfile]\n" unless defined ($in);
|
||||
|
||||
$out = $ARGV[1];
|
||||
$out = "$in.asc" unless defined ($out);
|
||||
|
||||
|
||||
#
|
||||
# Open files
|
||||
#
|
||||
|
||||
open(IN,"<$in") || die "Can not open $in for input!\n";
|
||||
|
||||
open(OUT,">$out") || die "Can not open $out for output!\n";
|
||||
|
||||
|
||||
#
|
||||
# Create FAQ - TOC
|
||||
#
|
||||
|
||||
print ("Creating TOC:\n");
|
||||
|
||||
while($line = <IN>) {
|
||||
|
||||
chop($line); # kill \n character (newline)
|
||||
|
||||
if ($line =~ s/^!1//g) { # main headline
|
||||
if ($state eq "begin") {
|
||||
$line = &latin2asc ($line);
|
||||
output_newline ("\n\n".$line);
|
||||
output_newline ("#" x length ($line));
|
||||
output_newline ("");
|
||||
$state = "!1";
|
||||
}
|
||||
else {
|
||||
print "ERROR: too many !1 or !1 improper located:\n";
|
||||
print "!1$line\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($state eq "begin") { # Vorspann...
|
||||
$line = &latin2asc ($line);
|
||||
output_newline ($line);
|
||||
}
|
||||
|
||||
elsif ($line =~ s/^!2//g) { # bigger headlines
|
||||
$maincount++;
|
||||
$subcount = 0;
|
||||
$qcount = 0;
|
||||
flush_output ();
|
||||
$line = &latin2asc ($line);
|
||||
output_newline ("\n\n$maincount $line");
|
||||
output_newline ("=" x (length($line)+length($maincount)+1));
|
||||
output_newline ("");
|
||||
$state = "!2";
|
||||
}
|
||||
|
||||
elsif ($line =~ s/^!3//g) { # smaller headlines
|
||||
$subcount++;
|
||||
$qcount = 0;
|
||||
flush_output ();
|
||||
$line = &latin2asc ($line);
|
||||
output_newline ("\n$maincount.$subcount $line");
|
||||
output_newline ("-" x (length($line)+length($maincount)+length($subcount)+2));
|
||||
output_newline ("");
|
||||
$state = "!3";
|
||||
}
|
||||
|
||||
elsif ($line =~ s/^!old//g) { # old mode on
|
||||
if ($old eq 0) {
|
||||
flush_output();
|
||||
$old = 1;
|
||||
}
|
||||
else {
|
||||
print "ERROR: more than 1 !old ($state $maincount.$subcount.$qcount):\n";
|
||||
print "!old$line\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($line =~ s/^Q: //g) { # questions
|
||||
|
||||
$qcount++;
|
||||
|
||||
# für jede Frage einen Punkt...
|
||||
print ".";
|
||||
|
||||
# index part
|
||||
if ($state ne "question") { # first line
|
||||
flush_output ();
|
||||
|
||||
# delete leading/trailing whitespace
|
||||
$line =~ s/^[ \t]*(.*?)[ \t]*$/$1/g;
|
||||
nice_output ( $line, "$qcount. ");
|
||||
}
|
||||
else {
|
||||
print "ERROR: \"Q: \" is already active ($state $maincount.$subcount.$qcount):\n";
|
||||
print "Q: $line\n";
|
||||
}
|
||||
$state = "question";
|
||||
}
|
||||
|
||||
elsif ($line =~ s/^A: //g) { # answers
|
||||
if ($state eq "question") {
|
||||
flush_output();
|
||||
$old = 0; # Kann wieder zurückschalten, da keine Ausgabe mehr...
|
||||
$state = "answer";
|
||||
}
|
||||
else {
|
||||
print "ERROR: \"A: \" is already active ($state $maincount.$subcount.$qcount):\n";
|
||||
print "A: $line\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($line =~ s/^!verbon//g) { # script mode on
|
||||
if ($state ne "script") {
|
||||
flush_output ();
|
||||
$buffer = $state;
|
||||
$state = "script";
|
||||
}
|
||||
else {
|
||||
print "ERROR: !verbon is already active ($state $maincount.$subcount.$qcount):\n";
|
||||
print "!verbon$line\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($line =~ s/^!verboff//g) { # script mode off
|
||||
if ($state eq "script") {
|
||||
flush_output ();
|
||||
$state = $buffer;
|
||||
}
|
||||
else {
|
||||
print "ERROR: missing !verbon ($state $maincount.$subcount.$qcount):\n";
|
||||
print "!verboff$line\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($state eq "script") { # script mode ("!verbon")
|
||||
if ($buffer eq "question") {
|
||||
# leave spaces/margin alone => keine Formattierung
|
||||
ugly_output ($line);
|
||||
}
|
||||
elsif ($buffer eq "answer") {
|
||||
# keine Ausgabe in der TOC
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($state eq "question") { # do while in question mode
|
||||
# delete leading/trailing whitespace
|
||||
$line =~ s/^[ \t]*(.*?)[ \t]*$/$1/g;
|
||||
if (length ($line) > 0) {
|
||||
nice_output ( $line);
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
flush_output();
|
||||
|
||||
#
|
||||
# Reopen Inputfile
|
||||
#
|
||||
|
||||
close (IN);
|
||||
print "\n";
|
||||
open(IN,"<$in") || die "Can not reopen $in for input!\n";
|
||||
|
||||
|
||||
#
|
||||
# Create main part of FAQ
|
||||
#
|
||||
|
||||
print ("Writing questions:\n");
|
||||
|
||||
$maincount= 0;
|
||||
$subcount = 0;
|
||||
$qcount = 0;
|
||||
|
||||
$state = "begin";
|
||||
$buffer = "-";
|
||||
|
||||
while($line = <IN>) {
|
||||
|
||||
chop($line); # kill \n character (newline)
|
||||
|
||||
if ($line =~ s/^!1//g) { # main headline
|
||||
if ($state eq "begin") {
|
||||
$line = &latin2asc ($line);
|
||||
output_newline ("");
|
||||
output_newline ("\n\n$line");
|
||||
output_newline ("#" x length ($line));
|
||||
output_newline ("");
|
||||
$state = "!1";
|
||||
}
|
||||
else {
|
||||
print "ERROR: too many !1 or !1 improper located:\n";
|
||||
print "!1$line\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($state eq "begin") { # Vorspann...
|
||||
# wurde schon ausgegeben => überspringen!
|
||||
}
|
||||
|
||||
elsif ($line =~ s/^!2//g) { # bigger headlines
|
||||
$maincount++;
|
||||
$subcount = 0;
|
||||
$qcount = 0;
|
||||
flush_output ();
|
||||
$line = &latin2asc ($line);
|
||||
output_newline ("");
|
||||
output_newline ("\n\n$maincount $line");
|
||||
output_newline ("=" x (length($line) + length($maincount) + 1));
|
||||
output_newline ("");
|
||||
$state = "!2";
|
||||
}
|
||||
|
||||
elsif ($line =~ s/^!3//g) { # smaller headlines
|
||||
$subcount++;
|
||||
$qcount = 0;
|
||||
flush_output ();
|
||||
$line = &latin2asc ($line);
|
||||
output_newline ("");
|
||||
output_newline ("\n\n$maincount.$subcount $line");
|
||||
output_newline ("-" x (length($line) + length($maincount) + length($subcount) + 2));
|
||||
output_newline ("");
|
||||
$state = "!3";
|
||||
}
|
||||
|
||||
elsif ($line =~ s/^!old//g) { # old mode on
|
||||
if ($old eq 0) {
|
||||
flush_output();
|
||||
$old = 1;
|
||||
}
|
||||
else {
|
||||
print "ERROR: more than 1 !old ($state $maincount.$subcount.$qcount):\n";
|
||||
print "!old$line\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($line =~ s/^Q: //g) { # questions
|
||||
|
||||
$qcount++;
|
||||
|
||||
# für jede Frage einen Punkt...
|
||||
print ".";
|
||||
|
||||
# index part
|
||||
if ($state ne "question") { # first line
|
||||
flush_output ();
|
||||
|
||||
# delete leading/trailing whitespace
|
||||
$line =~ s/^[ \t]*(.*?)[ \t]*$/$1/g;
|
||||
if ($qcount != 1) {
|
||||
output_newline("");
|
||||
}
|
||||
nice_output ( $line, "$qcount. ");
|
||||
}
|
||||
else {
|
||||
print "ERROR: \"Q: \" is already active ($state $maincount.$subcount.$qcount):\n";
|
||||
print "Q: $line\n";
|
||||
}
|
||||
$state = "question";
|
||||
}
|
||||
|
||||
elsif ($line =~ s/^A: //g) { # answers
|
||||
if ($state eq "question") {
|
||||
# delete leading/trailing whitespace
|
||||
$line =~ s/^[ \t]*(.*?)[ \t]*$/$1/g;
|
||||
ugly_output("");
|
||||
nice_output ( $line);
|
||||
$state = "answer";
|
||||
}
|
||||
else {
|
||||
print "ERROR: \"A: \" is already active ($state $maincount.$subcount.$qcount):\n";
|
||||
print "A: $line\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($line =~ s/^!verbon//g) { # script mode on
|
||||
if ($state ne "script") {
|
||||
flush_output ();
|
||||
$buffer = $state;
|
||||
$state = "script";
|
||||
}
|
||||
else {
|
||||
print "ERROR: !verbon is already active ($state $maincount.$subcount.$qcount):\n";
|
||||
print "!verbon$line\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($line =~ s/^!verboff//g) { # script mode off
|
||||
if ($state eq "script") {
|
||||
flush_output ();
|
||||
$state = $buffer;
|
||||
}
|
||||
else {
|
||||
print "ERROR: missing !verbon ($state $maincount.$subcount.$qcount):\n";
|
||||
print "!verboff$line\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($line =~ s/^!commenton//g) { # comment mode on
|
||||
if ($state ne "comment") {
|
||||
flush_output ();
|
||||
output_newline ("");
|
||||
$buffer = $state;
|
||||
$state = "comment";
|
||||
}
|
||||
else {
|
||||
print "ERROR: !commenton is already active ($state $maincount.$subcount.$qcount):\n";
|
||||
print "!commenton$line\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($line =~ s/^!commentoff//g) { # comment mode off
|
||||
if ($state eq "comment") {
|
||||
flush_output ();
|
||||
$state = $buffer;
|
||||
}
|
||||
else {
|
||||
print "ERROR: missing !commenton ($state $maincount.$subcount.$qcount):\n";
|
||||
print "!commentoff$line\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($state eq "question") { # do while in question mode
|
||||
# delete leading/trailing whitespace
|
||||
$line =~ s/^[ \t]*(.*?)[ \t]*$/$1/g;
|
||||
if (length ($line) > 0) {
|
||||
nice_output ( $line);
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($state eq "answer") { # do while in answer mode
|
||||
# delete leading/trailing whitespace
|
||||
$line =~ s/^[ \t]*(.*?)[ \t]*$/$1/g;
|
||||
if (length ($line) > 0) {
|
||||
nice_output ( $line);
|
||||
}
|
||||
else {
|
||||
flush_output ();
|
||||
output_newline ("");
|
||||
$old = 0;
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($state eq "script") { # script mode ("!verbon")
|
||||
if ($buffer eq "question") {
|
||||
# leave spaces/margin alone => keine Formattierung
|
||||
ugly_output ($line);
|
||||
}
|
||||
elsif ($buffer eq "answer") {
|
||||
# leave spaces/margin alone => keine Formattierung
|
||||
ugly_output ($line);
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($state eq "comment") {
|
||||
# delete leading/trailing whitespace
|
||||
$line =~ s/^[ \t]*(.*?)[ \t]*$/$1/g;
|
||||
comment_output ($line);
|
||||
}
|
||||
|
||||
elsif ($line =~ s/^<.*>//g) { # do if mark
|
||||
# leave spaces/margin alone
|
||||
# - and whatever the purpose of that part is after the change in
|
||||
# syntax... MatHes
|
||||
print "Skipped mark $&\n";
|
||||
}
|
||||
|
||||
else {
|
||||
# delete leading/trailing whitespace
|
||||
$line =~ s/^[ \t]*(.*?)[ \t]*$/$1/g;
|
||||
if (length($line) > 0) {
|
||||
comment_output ($line);
|
||||
}
|
||||
else {
|
||||
flush_output();
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
flush_output();
|
||||
ugly_output ("-" x 75);
|
||||
ugly_output ("(c) 1995,1996 Das FAQ-Team");
|
||||
|
||||
print "\n";
|
||||
|
||||
|
||||
#
|
||||
# Close files
|
||||
#
|
||||
|
||||
close (IN);
|
||||
close (OUT);
|
||||
|
||||
|
||||
sub ugly_output
|
||||
{ # Kein Wrapping, kein Rand (außer bei Änderungsstrich)
|
||||
# Input Parameter: Textzeile, evtl. Nummerierung (_als String_)
|
||||
my ($line ) = @_;
|
||||
|
||||
# Umlaute umwandeln
|
||||
$line = &latin2asc ($line);
|
||||
|
||||
# flush
|
||||
flush_output ();
|
||||
|
||||
# output...
|
||||
output_simple_line ($line);
|
||||
}
|
||||
|
||||
|
||||
sub comment_output
|
||||
{ # Wrapping, kein Rand, kein Änderungsstrich
|
||||
# Input Parameter: Textzeile, evtl. Numerierung (_als String_)
|
||||
my ($line) = @_;
|
||||
my $pos = 0;
|
||||
|
||||
# Umlaute umwandeln _vor_ Wrapping
|
||||
$line = &latin2asc ($line);
|
||||
|
||||
# Zeile anhängen mit korrektem Zwischenraum
|
||||
if (length ($line) > 0) {
|
||||
if (length ($commentline) > 0) {
|
||||
if (substr ($commentline, length ($commentline)) ne "-") {
|
||||
# Leerzeichen zwischen Zeilen einfügen, falls kein Trennstrich
|
||||
$commentline .= " ";
|
||||
}
|
||||
else {
|
||||
# Trennstrich entfernen
|
||||
$commentline = substr ($commentline, 0, length ($commentline) -1);
|
||||
}
|
||||
}
|
||||
# Zeile anhängen
|
||||
$commentline .= $line;
|
||||
}
|
||||
|
||||
# Zeilenweise ausgeben
|
||||
while( length( $commentline) > $maxlen+$margin || $commentline =~ /\n/) {
|
||||
$pos = wrap_pos ($commentline, $maxlen+$margin);
|
||||
if ($pos > 0) {
|
||||
output_newline (substr ($commentline, 0, $pos));
|
||||
# +1 für Trennzeichen: Space bzw. "\n"
|
||||
$commentline = substr ($commentline, $pos +1);
|
||||
}
|
||||
else {
|
||||
# kein wrapping möglich, da line zu lange => einfach abschneiden!
|
||||
# (zu kurze line muß aufgrund der while-Bedingung ja mindestens
|
||||
# ein "\n" als Trennzeichen haben => schon oben behandelt)
|
||||
output_newline (substr ($commentline, 0, $maxlen));
|
||||
$commentline = substr ($commentline, $maxlen);
|
||||
}
|
||||
}
|
||||
|
||||
# in commentline steht der Rest der Zeile...
|
||||
}
|
||||
|
||||
|
||||
sub nice_output
|
||||
{ # Wrapping und Rand
|
||||
# Input Parameter: Textzeile, evtl. Numerierung (_als String_)
|
||||
my ($line, $number ) = @_;
|
||||
$number = "" unless defined ($number);
|
||||
my $pos = 0;
|
||||
|
||||
# Umlaute umwandeln _vor_ Wrapping
|
||||
$line = &latin2asc ($line);
|
||||
|
||||
# flush actline, when new number comes in
|
||||
if (length ($number) > 0) {
|
||||
flush_output ();
|
||||
# Neue Nummer merken
|
||||
$lastnumber = $number;
|
||||
}
|
||||
|
||||
# Zeile anhängen mit korrektem Zwischenraum
|
||||
if (length ($line) > 0) {
|
||||
if (length ($actline) >0) {
|
||||
if (substr ($actline, length ($actline)) ne "-") {
|
||||
# Leerzeichen zwischen Zeilen einfügen, falls kein Trennstrich
|
||||
$actline .= " ";
|
||||
}
|
||||
else {
|
||||
# Trennstrich entfernen
|
||||
$actline= substr ($actline, 0, length ($actline) -1);
|
||||
}
|
||||
}
|
||||
# Zeile anhängen
|
||||
$actline .= $line;
|
||||
}
|
||||
|
||||
# Zeilenweise ausgeben
|
||||
while( length( $actline) > $maxlen || $actline =~ /\n/) {
|
||||
$pos = wrap_pos ($actline, $maxlen);
|
||||
if ($pos > 0) {
|
||||
print OUT format_margin( $lastnumber);
|
||||
print OUT substr ($actline, 0, $pos);
|
||||
print OUT "\n";
|
||||
# +1 für Trennzeichen: Space bzw. "\n"
|
||||
$actline = substr ($actline, $pos +1);
|
||||
}
|
||||
else {
|
||||
# kein wrapping möglich, da line zu lange => einfach abschneiden!
|
||||
# (zu kurze line muß aufgrund der while-Bedingung ja mindestens
|
||||
# ein "\n" als Trennzeichen haben => schon oben behandelt)
|
||||
print OUT format_margin( $lastnumber);
|
||||
print OUT substr ($actline, 0, $maxlen);
|
||||
print OUT "\n";
|
||||
$actline = substr ($actline, $maxlen);
|
||||
}
|
||||
$lastnumber = "";
|
||||
}
|
||||
|
||||
# in $actline steht der Rest der Zeile...
|
||||
}
|
||||
|
||||
|
||||
sub flush_output
|
||||
{
|
||||
# flush actline
|
||||
if (length ($actline) > 0) {
|
||||
print OUT format_margin( $lastnumber);
|
||||
print OUT $actline;
|
||||
print OUT "\n";
|
||||
$actline = "";
|
||||
$lastnumber = "";
|
||||
}
|
||||
|
||||
# flush commentline
|
||||
if (length ($commentline) > 0) {
|
||||
print OUT $commentline;
|
||||
print OUT "\n";
|
||||
$commentline = "";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub output_newline
|
||||
{ # Druckt eine Zeile (_ohne_ Änderungsstrich)
|
||||
# Achtung: die Umwandlung der Umlaute (latin2asc) muß schon erledigt sein!
|
||||
# Input Parameter: Textzeile
|
||||
my ($line) = @_;
|
||||
|
||||
print OUT $line;
|
||||
print OUT "\n";
|
||||
}
|
||||
|
||||
|
||||
sub output_simple_line
|
||||
{ # Gibt eine Textzeile aus, ggf. mit Änderungsstrich
|
||||
# Input Parameter: Textzeile
|
||||
my ($line) = @_;
|
||||
|
||||
flush_output();
|
||||
|
||||
if ($old == 0) {
|
||||
print OUT $bar;
|
||||
if ($line =~ /^ /) {
|
||||
print OUT substr ($line, $barlen);
|
||||
print OUT "\n";
|
||||
}
|
||||
else {
|
||||
print OUT $line;
|
||||
print OUT "\n";
|
||||
}
|
||||
}
|
||||
else {
|
||||
print OUT $line;
|
||||
print OUT "\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub wrap_pos
|
||||
{
|
||||
# Input Parameter: Textzeile
|
||||
my ($line, $maxlen ) = @_;
|
||||
my $pos1 = 0;
|
||||
my $pos2 = 0;
|
||||
|
||||
$pos1 = index( $line, "\n");
|
||||
if ($pos1 <= $maxlen && $pos1 >= 0) { # !br/Zeilenumbrüche berücksichtigen
|
||||
return $pos1;
|
||||
}
|
||||
else {
|
||||
$pos2 = rindex( $line, " ", $maxlen); # wo word wrapping?
|
||||
if ($pos2 <= $maxlen && $pos2 >= 0) {
|
||||
return $pos2;
|
||||
}
|
||||
else { # Kein wrapping möglich
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub format_margin
|
||||
{
|
||||
my( $number) = @_; # Input Parameter: evtl. Nummerierung _als String_
|
||||
my $out = "";
|
||||
|
||||
if (length ($number) > 0) {
|
||||
if ($old == 0) {
|
||||
$out = $bar;
|
||||
$out .= " " x ($margin - length ($number) -$barlen); # Margin
|
||||
$out .= $number;
|
||||
}
|
||||
else {
|
||||
$out = " " x ($margin - length ($number)); # Margin
|
||||
$out .= $number;
|
||||
}
|
||||
}
|
||||
else {
|
||||
if ($old == 0) {
|
||||
$out = $bar;
|
||||
$out .= " " x ($margin -$barlen); # Margin
|
||||
}
|
||||
else {
|
||||
$out .= " " x $margin; # Margin
|
||||
}
|
||||
}
|
||||
return $out;
|
||||
}
|
||||
|
||||
|
||||
sub latin2asc
|
||||
{
|
||||
my ($line) = @_;
|
||||
|
||||
# native codes
|
||||
$line =~ s/ä/ae/g;
|
||||
$line =~ s/ö/oe/g;
|
||||
$line =~ s/ü/ue/g;
|
||||
$line =~ s/Ä/Ae/g;
|
||||
$line =~ s/Ö/Oe/g;
|
||||
$line =~ s/Ü/Ue/g;
|
||||
$line =~ s/ß/ss/g;
|
||||
|
||||
# !br als Umbruch verwenden
|
||||
$line =~ s|!br|\n|g;
|
||||
while ($line =~ /!link /) {
|
||||
my $pos1= 0;
|
||||
my $pos2= 0;
|
||||
my $url= "";
|
||||
|
||||
$pos1= index($line, "!link ");
|
||||
$pos2= index($line, ";", $pos1);
|
||||
if ($pos2 == -1) {
|
||||
$pos2= length($line);
|
||||
}
|
||||
$url= substr($line, $pos1+length("!link "),
|
||||
$pos2-$pos1-length("!link "));
|
||||
$line = substr($line, 0, $pos1)
|
||||
. " $url "
|
||||
. substr($line, $pos2+1);
|
||||
}
|
||||
|
||||
# Hervorhebungen
|
||||
$line =~ s|!b1|*|g;
|
||||
$line =~ s|!b0|*|g;
|
||||
$line =~ s|!i1|/|g;
|
||||
$line =~ s|!i0|/|g;
|
||||
$line =~ s|!u1|_|g;
|
||||
$line =~ s|!u0|_|g;
|
||||
|
||||
return $line;
|
||||
}
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# $Id: addgrad.pl,v 1.1 1997/02/19 19:54:51 hailer Exp $
|
||||
|
||||
($infile, $outfile) = @ARGV;
|
||||
|
||||
$infile = "i4l-faq.diff" until $infile;
|
||||
$outfile = "$infile.ext" until $outfile;
|
||||
|
||||
open(IN,"<$infile") || die "cannot open $infile";
|
||||
open(OUT,">$outfile") || die "cannot open $outfile";
|
||||
|
||||
while(<IN>) {
|
||||
|
||||
if (/^\+/) {
|
||||
if ( /^\+\+/ ) {
|
||||
print OUT "$_";
|
||||
}
|
||||
else {
|
||||
print OUT "+°";
|
||||
print OUT "$'";
|
||||
}
|
||||
}
|
||||
else {
|
||||
print OUT "$_";
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# $Id: dropgrad.pl,v 1.1 1997/02/19 19:54:51 hailer Exp $
|
||||
|
||||
($infile, $outfile) = @ARGV;
|
||||
|
||||
$infile = "de-i4l-faq" until $inputfile;
|
||||
$outfile = "$infile.out" until $outfile;
|
||||
|
||||
open(IN,"<$infile") || die "cannot open $infile";
|
||||
open(OUT,">$outfile") || die "cannot open $outfile";
|
||||
|
||||
while(<IN>) {
|
||||
|
||||
if (/^\°/) {
|
||||
print OUT "$'";
|
||||
}
|
||||
else {
|
||||
print OUT "$_";
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,316 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# Creates HTML version from Latin-1 FAQ
|
||||
#
|
||||
# (c) 1996 Volker Götz <volker@oops.franken.de> (V 1.0)
|
||||
# modified 08-Nov-96 Bernhard Hailer <dl4mhk@lrz.uni-muenchen.de>
|
||||
# modified 11-Nov-96 Matthias Heßler <hessler@wi-inf.uni-essen.de>
|
||||
#
|
||||
# $Id: html.pl,v 1.1 1997/02/19 19:54:52 hailer Exp $
|
||||
|
||||
|
||||
#
|
||||
# variables
|
||||
#
|
||||
|
||||
$maincount = 0;
|
||||
$subcount = 0;
|
||||
$qcount = 0;
|
||||
|
||||
$state = "title";
|
||||
$buffer = "-";
|
||||
|
||||
$script = "FALSE";
|
||||
|
||||
|
||||
#
|
||||
# Get file names from prompt
|
||||
#
|
||||
|
||||
$in = $ARGV[0];
|
||||
die "Usage: GenHTML.pl infile [outfile] [headtempfile] [tailtempfile]\n" unless length ($in) gt 0;
|
||||
|
||||
$out = $ARGV[1];
|
||||
$out = "$in.html" unless length ($out) gt 0;
|
||||
|
||||
$head = $ARGV[2];
|
||||
$head = "head.tmp" unless length ($head) gt 0;
|
||||
|
||||
$tail = $ARGV[3];
|
||||
$tail = "tail.tmp" unless length ($tail) gt 0;
|
||||
|
||||
|
||||
#
|
||||
# Open files
|
||||
#
|
||||
|
||||
open(IN,"<$in") || die "Can not open $in for input!\n";
|
||||
|
||||
open(TAIL,">$tail") || die "Can not open $tail for output!\n";
|
||||
open(HEAD,">$head") || die "Can not open $head for output!\n";
|
||||
|
||||
|
||||
#
|
||||
# Create FAQ
|
||||
#
|
||||
|
||||
print ("Creating html temp files...\n");
|
||||
|
||||
print HEAD "<HTML>\n";
|
||||
|
||||
while($line = <IN>) {
|
||||
|
||||
chop($line); # kill \n character (newline)
|
||||
$line = &latin2html ($line); # convert Umlaut's
|
||||
|
||||
if ($state eq "title") { # pre text of FAQ
|
||||
print HEAD "<HEAD>\n";
|
||||
print HEAD "<TITLE>$inputfile</TITLE>\n";
|
||||
print HEAD "</HEAD>\n\n";
|
||||
print HEAD "<BODY>\n";
|
||||
print HEAD "<PRE>\n";
|
||||
print HEAD "$line\n";
|
||||
$state = "begin";
|
||||
}
|
||||
|
||||
elsif ($line =~ /^!1/) { # main headline
|
||||
if ($state eq "begin") {
|
||||
print HEAD "</PRE>\n\n<HR>\n<P>\n\n<H1>$'</H1>\n\n";
|
||||
print TAIL "</PRE>\n\n<HR>\n<P>\n\n<H1>$'</H1>\n\n";
|
||||
$state = "!1";
|
||||
}
|
||||
else {
|
||||
print "ERROR: too many !1 or !1 improper located:\n";
|
||||
print "$line\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($state eq "begin") { # body of FAQ begins
|
||||
print HEAD "$line\n";
|
||||
}
|
||||
|
||||
elsif ($line =~ /^!old/) {
|
||||
# DUMMY; sonst erscheint das !old in der HTML-Version.
|
||||
# Hier später die !old-Auswertung einfügen.
|
||||
}
|
||||
|
||||
elsif ($line =~ /^!2/) { # bigger headlines
|
||||
$maincount++;
|
||||
$subcount = 0;
|
||||
$qcount = 0;
|
||||
if ($state eq "!1") { # first headline needs no </OL>
|
||||
print HEAD "\n\n<H2>$maincount $'</H2>\n\n<OL>\n";
|
||||
print TAIL "\n\n<H2>$maincount $'</H2>\n\n<OL>\n";
|
||||
}
|
||||
else {
|
||||
print HEAD "</OL>\n<P>\n\n<H2>$maincount $'</H2>\n\n<OL>\n";
|
||||
print TAIL "</OL>\n<P>\n<BR><BR>\n<H2>$maincount $'</H2>\n\n<OL>\n";
|
||||
}
|
||||
$state = "!2";
|
||||
}
|
||||
|
||||
elsif ($line =~ /^!3/) { # smaller headlines
|
||||
$subcount++;
|
||||
$qcount = 0;
|
||||
print HEAD "</OL>\n<P>\n\n<H3>$maincount.$subcount $'</H3>\n\n<OL>\n";
|
||||
print TAIL "</OL>\n<P>\n<BR><BR>\n<H3>$maincount.$subcount $'</H3>\n\n<OL>\n";
|
||||
$state = "!3";
|
||||
}
|
||||
|
||||
elsif ($line =~ /^Q: /) { # questions
|
||||
|
||||
# index part
|
||||
$qcount++;
|
||||
if ($state eq "question") {
|
||||
print HEAD "$'\n"; # first line was already printed
|
||||
print TAIL "$'\n";
|
||||
}
|
||||
else {
|
||||
print HEAD "<LI><A HREF=\"#$maincount.$subcount.$qcount\">$'\n";
|
||||
print TAIL "<BR><BR>\n" unless $maincount == 0;
|
||||
print TAIL "<A NAME=\"$maincount.$subcount.$qcount\"></A>\n";
|
||||
print TAIL "<LI><B>$'\n";
|
||||
}
|
||||
$state = "question";
|
||||
}
|
||||
|
||||
elsif ($line =~ /^A: /) { # answers
|
||||
if ($state eq "question") {
|
||||
print HEAD "</A>\n"; # stop link in question line
|
||||
print TAIL "</B>\n<BR>\n<BR>\n\n$'\n";
|
||||
$state = "answer";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($line =~ /^!verbon/) { # script mode on
|
||||
if ($script eq "TRUE") {
|
||||
print "ERROR: !verbon is already active ($state $maincount.$subcount.$qcount):\n";
|
||||
print "$line\n";
|
||||
}
|
||||
else {
|
||||
$script = "TRUE";
|
||||
print TAIL "<PRE>\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($line =~ /^!verboff/) { # script mode off
|
||||
if ($script eq "TRUE") {
|
||||
$script = "FALSE";
|
||||
print TAIL "</PRE><BR>\n";
|
||||
}
|
||||
else {
|
||||
print "ERROR: missing !verbon ($state $maincount.$subcount.$qcount):\n";
|
||||
print "$line\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($line =~ /^!commenton/) { # comment mode on
|
||||
if ($state eq "comment") {
|
||||
print "ERROR: !commenton is already active ($state $maincount.$subcount.$qcount):\n";
|
||||
print "$line\n";
|
||||
}
|
||||
else {
|
||||
$buffer = $state;
|
||||
$state = "comment";
|
||||
print TAIL "<P>\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($line =~ /^!commentoff/) { # comment mode off
|
||||
if ($state eq "comment") {
|
||||
$state = $buffer;
|
||||
}
|
||||
else {
|
||||
print "ERROR: missing !commenton ($state $maincount.$subcount.$qcount):\n";
|
||||
print "$line\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($state eq "question") { # do while in question mode
|
||||
print HEAD "$line\n";
|
||||
print TAIL "$line\n";
|
||||
}
|
||||
|
||||
elsif ($state eq "answer") { # do while in answer mode
|
||||
if (length ($line) > 0) {
|
||||
print TAIL "$line\n";
|
||||
}
|
||||
else {
|
||||
print TAIL "<P>\n";
|
||||
# $old = 0;
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($script eq "TRUE") {
|
||||
if ($state eq "question") {
|
||||
print HEAD "$line\n";
|
||||
print TAIL "$line\n";
|
||||
}
|
||||
elsif ($state eq "answer") {
|
||||
print TAIL "$line\n";
|
||||
}
|
||||
}
|
||||
|
||||
elsif ($state eq "comment") {
|
||||
print TAIL "$line\n";
|
||||
}
|
||||
|
||||
else {
|
||||
print TAIL "$line\n";
|
||||
}
|
||||
}
|
||||
|
||||
print HEAD "</OL>\n";
|
||||
print TAIL "</OL>\n";
|
||||
print TAIL "<HR>\n";
|
||||
print TAIL "© 1995,1996 ";
|
||||
print TAIL "<A HREF=\"mailto:dl4mhk\@lrz.uni-muenchen.de?cc=hessler\@wi-inf.uni-essen.de\?subject=i4l-faq\">Das FAQ-Team</A>\n";
|
||||
print TAIL "</BODY>\n</HTML>\n";
|
||||
|
||||
|
||||
#
|
||||
# Close files
|
||||
#
|
||||
|
||||
close (IN);
|
||||
close (HEAD);
|
||||
close (TAIL);
|
||||
|
||||
|
||||
#
|
||||
# Write output file (concat head and tail)
|
||||
#
|
||||
|
||||
print ("Writing html file...\n");
|
||||
|
||||
open(OUT,">$out") || die "Can not open $out for output!\n";
|
||||
|
||||
open(HEAD,"<$head") || die "Can not reopen $head for input!\n";
|
||||
while (<HEAD>) { print OUT; }
|
||||
close (HEAD);
|
||||
|
||||
open(TAIL,"<$tail") || die "Can not reopen $tail for input!\n";
|
||||
while (<TAIL>) { print OUT; }
|
||||
close (TAIL);
|
||||
|
||||
close (OUT);
|
||||
|
||||
|
||||
#
|
||||
# Cleanup
|
||||
#
|
||||
|
||||
unlink ($head) || die "Could not delete temp file $head!\n";
|
||||
unlink ($tail) || die "Could not delete temp file $head!\n";
|
||||
|
||||
|
||||
#
|
||||
# subroutines
|
||||
#
|
||||
|
||||
sub latin2html
|
||||
{
|
||||
local ($line) = @_;
|
||||
|
||||
# native codes
|
||||
$line =~ s/&/&/g;
|
||||
$line =~ s/</</g;
|
||||
$line =~ s/>/>/g;
|
||||
|
||||
$line =~ s/ä/ä/g;
|
||||
$line =~ s/ö/ö/g;
|
||||
$line =~ s/ü/ü/g;
|
||||
$line =~ s/Ä/Ä/g;
|
||||
$line =~ s/Ö/Ö/g;
|
||||
$line =~ s/Ü/Ü/g;
|
||||
$line =~ s/ß/ß/g;
|
||||
|
||||
# special codes
|
||||
$line =~ s|!br|<BR>|g;
|
||||
while ($line =~ /!link /) {
|
||||
my $pos1= 0;
|
||||
my $pos2= 0;
|
||||
my $url= "";
|
||||
|
||||
$pos1= index($line, "!link ");
|
||||
$pos2= index($line, ";", $pos1);
|
||||
if ($pos2 == -1) {
|
||||
$pos2= length($line);
|
||||
}
|
||||
$url= substr($line, $pos1+length("!link "),
|
||||
$pos2-$pos1-length("!link "));
|
||||
$line = substr($line, 0, $pos1)
|
||||
. "<A HREF=\"$url\" TARGET=_top>$url</A>"
|
||||
. substr($line, $pos2+1);
|
||||
}
|
||||
|
||||
# Hervorhebungen
|
||||
$line =~ s|!b1|<B>|g;
|
||||
$line =~ s|!b0|</B>|g;
|
||||
$line =~ s|!i1|<I>|g;
|
||||
$line =~ s|!i0|</I>|g;
|
||||
$line =~ s|!u1|<U>|g;
|
||||
$line =~ s|!u0|</U>|g;
|
||||
|
||||
return $line;
|
||||
}
|
||||
|
|
@ -0,0 +1,64 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# Marks all Questions in FAQ as new.
|
||||
#
|
||||
# (c) 1996 Matthias Heßler <hessler@wi-inf.uni-essen.de>
|
||||
#
|
||||
# $Id: new.pl,v 1.1 1997/02/19 19:54:52 hailer Exp $
|
||||
|
||||
#
|
||||
# Get file names from prompt
|
||||
#
|
||||
|
||||
$in = $ARGV[0];
|
||||
die "Usage: new.pl infile [outfile]\n" unless length ($in) gt 0;
|
||||
|
||||
$out = $ARGV[1];
|
||||
$out = "$in" unless length ($out) gt 0;
|
||||
|
||||
|
||||
#
|
||||
# Open files
|
||||
#
|
||||
|
||||
if ("$in" eq "$out") {
|
||||
if( -e "$in.orig") {
|
||||
unlink( "$in.orig") || die "Can not remove $in.orig!\n";
|
||||
}
|
||||
rename( "$in", "$in.orig") || die "Can not rename $in to $in.orig!\n";
|
||||
$in .= ".orig";
|
||||
}
|
||||
|
||||
open(IN,"<$in") || die "Can not open $in for input!\n";
|
||||
open(OUT,">$out") || die "Can not open $out for output!\n";
|
||||
|
||||
|
||||
#
|
||||
# Updating FAQ
|
||||
#
|
||||
|
||||
print "Marking all FAQ questions as new...\n";
|
||||
|
||||
$old = 0;
|
||||
|
||||
while($line = <IN>) {
|
||||
|
||||
chop($line); # kill \n character (newline)
|
||||
|
||||
if ($line =~ /^!old/) { # remove all "!old"
|
||||
# Do not output line...
|
||||
}
|
||||
else {
|
||||
print OUT "$line\n";
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Close files
|
||||
#
|
||||
|
||||
close (IN);
|
||||
close (OUT);
|
||||
|
||||
|
|
@ -0,0 +1,71 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# Marks all Questions in FAQ as old.
|
||||
#
|
||||
# (c) 1996 Matthias Heßler <hessler@wi-inf.uni-essen.de>
|
||||
#
|
||||
# $Id: old.pl,v 1.1 1997/02/19 19:54:52 hailer Exp $
|
||||
|
||||
#
|
||||
# Get file names from prompt
|
||||
#
|
||||
|
||||
$in = $ARGV[0];
|
||||
die "Usage: old.pl infile [outfile]\n" unless length ($in) gt 0;
|
||||
|
||||
$out = $ARGV[1];
|
||||
$out = "$in" unless length ($out) gt 0;
|
||||
|
||||
|
||||
#
|
||||
# Open files
|
||||
#
|
||||
|
||||
if ("$in" eq "$out") {
|
||||
if( -e "$in.orig") {
|
||||
unlink( "$in.orig") || die "Can not remove $in.orig!\n";
|
||||
}
|
||||
rename( "$in", "$in.orig") || die "Can not rename $in to $in.orig!\n";
|
||||
$in .= ".orig";
|
||||
}
|
||||
|
||||
open(IN,"<$in") || die "Can not open $in for input!\n";
|
||||
open(OUT,">$out") || die "Can not open $out for output!\n";
|
||||
|
||||
|
||||
#
|
||||
# Updating FAQ
|
||||
#
|
||||
|
||||
print "Marking all FAQ questions as old...\n";
|
||||
|
||||
$old = 0;
|
||||
|
||||
while($line = <IN>) {
|
||||
|
||||
chop($line); # kill \n character (newline)
|
||||
|
||||
if ($line =~ /^!old/) { # remove all "!old"
|
||||
# Do not output line...
|
||||
}
|
||||
|
||||
elsif ($line =~ /^Q: /) { # questions
|
||||
print OUT "!old\n";
|
||||
|
||||
print OUT "$line\n";
|
||||
}
|
||||
|
||||
else {
|
||||
print OUT "$line\n";
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Close files
|
||||
#
|
||||
|
||||
close (IN);
|
||||
close (OUT);
|
||||
|
||||
Loading…
Reference in New Issue