#!/usr/bin/perl -w
#
# tab2xml: Change a tab-delimited (or similar) file to XML.
#
# 2006-09-07: Written by Steven J. DeRose, sderose@acm.org.
# 2007-01-25 sjd: More flexible i/o options. -nonxml, -norm, -qwhere, -escape,
#    -outlineend, etc.
# 2007-02-07 sjd: Add -comment, -ocomment.
# 2007-11-27 sjd: strict.
# 2008-01-18 sjd: Getopt. Lots of bug fixes. Add -overflow, -tableattrs.
# 2008-03-25 sjd: Implement -quote, -escape, fix msq, linebreaking, regexes,
#     error-reporting, -lineends. Make it actually work.
# 2008-04-14 sjd: Add -empty.
#
# To do:
#    Distinguish start/end delim for non-XML output
#    Allow to set up colspecs
#    Consider adding some layout options like normalizeXML.
#    Support named DTDs: cals, html, etc.
#

use strict;
use Getopt::Long;

my $version = "2008-04-14";

my $dft_delim   = "\\s+";
my $dft_odelim  = "\t";
my $dft_oquote  = "\"";
my $dft_oescape = "\\";
my $dft_empty   = " ";

################################################################################
# Input options:
my $delim      = $dft_delim;   # regex for split() to break into fields
my $header     = 0;            # 1st records is field names?
my $msq        = 0;            # Use funky MS quoting?
my $quote      = "";           # Quote character to expect?
my $escape     = "";           # Escape char for the quote?
my $lineends   = "U";          # Platform specific line-separators
my $nfields    = 0;            # Number of fields per line (0 = don't care)
my $norm       = 1;            # Normalize input whitespace?
my $overflow   = "fatal";      # What to do with "too many" fields in a record.
my $comments   = 0;            # Treat \# lines as comments?

# XML output options:
my $ampEntity    = "&";    # What to write for ampersand
my $ltEntity     = "<";     # What to write for less-than
my $entityFormat = "XXXXX";    # Change to work like normalizeXML?

my $colspecs   = "";           # Info to put in colspec elements
my $empty = $dft_empty;        # What to put in empty cells
my $id         = "";           # Put IDs on rows?
my $indent     = 0;            # Break and indent XML output?
my $indents    = "   ";        # String to use for indenting
my $headingTag = "th";         # Tag for heading fields
my $fieldTag   = "td";         # Tag to use for other fields
my $namestring = "";           # List of user-specified field names
my $useClass   = 0;            # Put field-name on class attribute?
my $recordTag  = "tr";         # Tag to surround whole records
my $rootTag    = "table";      # Tag to surround entire table
my $tableAttrs = "";           # Attribute string to add on table element.

my $public     = "";           # Public identifier to put in DOCTYPE
my $system     = "";           # System identifier to put in DOCTYPE
my $xmldcl     = 0;            # Write XML declaration?

# Non-XML output options:
my $nonxmlOutput = 0;          # Write non-XML?
my $odelim     = $dft_odelim;  # Field separator to use
my $oheader    = 0;            # Write first record with field names?
my $oquote     = $dft_oquote;  # Quoting charcter to use
my $oqwhere    = "delim";      # Which fields to quote? none|all|num|text|delim
my $oescape    = $dft_oescape; # Escape char for quotes?
my $olineends  = "u";          # Line-end type to use
my $ocomments  = 1;            # Copy -comments lines to output?

# General options:
my $help       = 0;
my $quiet      = 0;
my $verbose    = 0;


###############################################################################

# Process options
Getopt::Long::Configure ("ignore_case");
my $result = GetOptions(
    # Input options
    "comments"          => \$comments,
    "delim=s"           => \$delim,
    "escape=s"          => \$escape,
    "header"            => \$header,
    "lineends=s"        => sub {
         $lineends = uc(substr("$ARGV[0]"."U", 0, 1));
     },	
    "msq"               => \$msq,
    "nfields=i"         => \$nfields,
    "overflow=s"        => \$overflow,
    "quote=s"           => \$quote,

    # XML output options
    "empty=s"           => \$empty,
    "id=s"              => \$id,
    "indent"            => \$indent,
    "istring=s"         => \$indents,
    "names=s"           => \$namestring,
    "nonxml"            => \$nonxmlOutput,
    "numerics=s"        => \$entityFormat,

    "colspecs=s"        => \$colspecs,
    "class"             => \$useClass,
    "td|field=s"        => \$fieldTag,
    "th|heading=s"      => \$headingTag,
    "tr|record=s"       => \$recordTag,
    "table|root=s"      => \$rootTag,
    "tableattrs=s"      => \$tableAttrs,
    "public=s"          => \$public,
    "system=s"          => \$system,
    "xmldcl"            => \$xmldcl,

    # nonxml output options
    "ocomments"         => \$ocomments,
    "odelim=s"          => \$odelim,
    "oheader"           => \$oheader,
    "olineends=s"        => sub {
         $olineends = uc(substr("$ARGV[0]"."U", 0, 1));
     },
    "oquote"            => \$oquote,
    "oqwhere=s"         => \$oqwhere,

    # Other options
    "h|help|?"          => \$help,
    "q|quiet!"          => \$quiet,
    "v|verbose+"        => \$verbose,
    "version"           => sub {
        die "Version of $version, by Steven J. DeRose, sderose\@acm.org.\n";
    }
    );

if ($help) { showUsage(); exit; }
($result) || die "Bad options.\n";


# Validate and default options

# Set up amp/lt entities
my $lt; my $amp; my $prefix;
if    ($entityFormat =~ /x/) { $prefix = "&#x"; $amp = "26"; $lt = "3c"; }
elsif ($entityFormat =~ /X/) { $prefix = "&#X"; $amp = "26"; $lt = "3C"; }
else                         { $prefix = "&#";  $amp = "38"; $lt = "60"; }
if (length($entityFormat) > 2) {
    $prefix .= "0" x (length($entityFormat) - 2);
}
$ampEntity = "$prefix$amp;";
$ltEntity =  "&prefix$lt;";

($colspecs) &&
    die "-colspecs is not yet supported.\n";
($delim) ||
    die "Bad value for -d option.\n";
($entityFormat =~ m/^(9+|x+|X+)$/) ||
    die "Invalid -numeric format '$entityFormat'.\n";

$olineends = lc($olineends);
if    ($olineends eq "u") { $olineends = chr(10); }
elsif ($olineends eq "m") { $olineends = chr(13); }
elsif ($olineends eq "d") { $olineends = chr(10) . chr(13); }
else { die "Unknown output line-end type '$olineends'.\n"; }

$oqwhere = lc($oqwhere);
if ($oqwhere eq "none" || $oqwhere eq "num" || $oqwhere eq "text"
    || $oqwhere eq "all" || $oqwhere eq "delim") {
    $oqwhere = $oqwhere;
}
else { die "Unknown value for '-oqwhere': '$oqwhere'.\n"; }

$overflow = lc($overflow);
($overflow =~ m/^(fatal|discard|class)$/) ||
    die "Bad value '$overflow' for -overflow option.\n";

if ($msq && $delim ne "\t" && $delim ne ",") {
    die "Can only have comma or tab as delimiter with -msq option.\n";
}

################################################################################
# Collect field names, if available from first record or option
my @names = ();
if ($header) {
    my $headline = <>;
    chomp($headline);
    @names = split(/$delim/, $headline);
    ($verbose) && warn "Header names: " . join(", ",@names) . ".\n";
}
elsif ($namestring ne "") {
    @names = split(/\s+/,$namestring);
}
# Ensure they're ok XML names (and we limit to ASCII for now)
for (my $i=0; $i<scalar @names; $i++) {
    $names[$i] = fixName($names[$i]);
}
($verbose) && warn "Number of field names found: " . (scalar @names) . "\n";
($verbose) && warn "   Names: " . join("+",@names) . "\n";


################################################################################
# Write optional XML header stuff
if (!$nonxmlOutput) { 
    if ($xmldcl) {
        print "<?xml version='1.0' encoding='utf-8'?>$olineends";
    }
    if ($public) {
        print "<!DOCTYPE $rootTag PUBLIC '$public' '$system' []>";
        ($indent) && print "$olineends";
    }
    elsif ($system) {
        print "<!DOCTYPE $rootTag SYSTEM '$public' '$system' []>";
        ($indent) && print "$olineends";
    }
	($verbose) && warn "tableattrs: '$tableAttrs'.\n";
    startTag($rootTag, $tableAttrs);
}


# Write the header if needed
if ($oheader) {
    if (!$nonxmlOutput) {
        print "<thead>";
	($indent) && print $olineends;
        foreach my $h (@names) {
            print "<$headingTag>$h</$headingTag>";
	    ($indent) && print $olineends;
        }
        print "</thead>";
	($indent) && print $olineends;
    }
    else {
        print join($odelim,@names) . $olineends;
    }
} # oheader


################################################################################
# Start processing the main part of the file

my $recnum = 0;
my $maxf = 0;
my $minf = 0;
my $level = 0;
my @fields = ();

while (<>) { # Convert the data
    $recnum++;
    my $line = $_;
    $line =~ s/\r\n/\n/; # Nuke DOS line-ends
    chomp $line;

    ($verbose) && warn "Read: '$line'\n";

    if ($line =~ m/^\s*$/) { next; }         # blank line

    if ($comments && $line =~ m/^\s*\#/) {   # comment line
	if (!$ocomments) {
	    # no-op
	}
	elsif ($nonxmlOutput) {
	    print "$line$olineends";
	}
	else {
	    ($indent) && print $olineends;
	    print "<!-- $line -->";
	    ($indent) && print $olineends;
	}
        next;
    }
        
    # Parse the line into fields
    @fields = ();
    if ($msq && index($_,"\"")>=0) {
	($verbose) && warn "parsing as msq\n";
        # Load more records if there's an unbalanced double-quote.
        while (countChar($line,"\"") % 2) {  # unbalanced
            $line =~ s/\n/\&\#10;/g; 
            $line .= <>;
        }
        # Now parse the Excel way: use '""' for quote in quoted field.
        $line =~ s/\"\"/\&quot;/g;
        # What else might the quotes be quoting? just tabs or commas?
        while ($line) {
            $line =~ s/^\s+//;
            if (substr($line,0,1) eq "\"") {
                $line =~ s/\"([^\"]*)\"//;
            }
            else {
                $line =~ s/([^$delim]*)//;
            }
            push @fields, $1;
            $line =~ s/^\s*$delim//;
        } # while
    } # msq with quotes

    elsif ($quote ne "") {
	($verbose) && warn "parsing with -quote '$quote': '$line'\n";
	my $token = "";
        while ($line) {
            $line =~ s/^\s+//;
            if (substr($line,0,1) ne $quote) {
                $line =~ s/([^$delim]*)//;
		$token = $1;
            }
            elsif ($escape ne "") {
                $line =~ s/^$quote(([^$quote]|$escape$quote)*)$quote//;
		$token = $1;
		$token =~ s/$escape$quote/$quote/g; # Ok for multiple quotes??
            }
            else {
                $line =~ s/^$quote([^$quote]*)$quote//;
		$token = $1;
            }
	    ($verbose) && warn "    token: '$token', rest '$line'.\n";
            push @fields, $token;
            $line =~ s/^\s*$delim//;
        } # while
    }

    else {
	($verbose) && warn "parsing with no quoting.\n";
        @fields = split(/$delim/, $line);
    }

    my $fieldsInThisRec = scalar @fields;
    if ($fieldsInThisRec > $maxf)           { $maxf = $fieldsInThisRec; }
    if ($minf==0 || $fieldsInThisRec<$minf) { $minf = $fieldsInThisRec; }    
	($verbose) &&
		warn "Parsed record into:\n    " . join("\n    ",@fields) . "\n";

    if ($norm) { # Normalize whitespace
        for (my $i=0; $i<scalar @fields; $i++) {
            $fields[$i] =~ s/^\s*//;
            $fields[$i] =~ s/\s*$//;
            $fields[$i] =~ s/\s\s*/ /g;
        }
    }

	# Deal with having wrong number of fields
    if ($nfields!=0 && $fieldsInThisRec!=$nfields) {
        warn "Wrong number of fields ($fieldsInThisRec) in record $recnum,"
	    . " using delimiter /$delim/:\n"
			. "$line\n";
	for (my $i=0; $i<$fieldsInThisRec; $i++) {
	    warn sprintf("    %4d: '%s'\n", $i, $fields[$i]);
	}
	exit;
    }
    my $excess = $fieldsInThisRec - scalar(@names);
    if ($excess > 0 && scalar(@names) > 0) {
	if ($overflow eq "fatal") {
	    die "Too many fields ($fieldsInThisRec) in record $recnum:\n$line\n";
	}
	if ($overflow eq "discard") {
	    splice(@fields, 0 - $excess);
	}
    }
    
    # Write out the record 
    if (!$nonxmlOutput) {
        startTag($recordTag,
		 (($id) ? "id=\"$id\_$recnum\"":""));
        for (my $i=0; $i<scalar @fields; $i++) {
			my $curname = ($i<scalar(@names)) ? $names[$i]:"td";
            if ($useClass) { startTag("$fieldTag class='$curname'"); }
            else { startTag($curname); }
            print arrangeContent($fields[$i]);
            if ($useClass) { endTag($fieldTag); }
            else { endTag($curname); }
        }
        endTag($recordTag, 1); # '1' to get newline.
    }
    else {
        for (my $i=0; $i<scalar @names; $i++) {
            my $of = $fields[$i];
            print doQuote($of) . $odelim;
        }
        print $olineends;
    }
} # while not EOF

($nonxmlOutput) || endTag($rootTag);
print "$olineends";

($verbose) &&
    warn "Done ($recnum records converted, min fields $minf, max $maxf)\n";
($maxf == 1) &&
    warn "Only one field found per line. Did you forget to set -delim?\n";

exit;


################################################################################

# Quote (and escape) the field if needed, and return.
sub doQuotes {
    my $f = $_[0];
    my $do = 0;
    if    ($oqwhere eq "none")                                    { $do = 0; }
    elsif ($oqwhere eq "all")                                     { $do = 1; }
    elsif ($oqwhere eq "delim" && $f =~ m/$oquote/)               { $do = 1; }
    elsif ($oqwhere eq "num"   && $f =~ m/^\s*[+-]?[0-9.]+\s*$/)  { $do = 1; }
    elsif ($oqwhere eq "text"  && $f !~ m/^\s*[+-]?[0-9.]+\s*$/)  { $do = 1; }

    if ($do) { 
        $f = "$oquote$f$oquote";
        $f =~ s/$oquote/$oescape$oquote/g;
    }
    return $f;
}
    
# Count occurrences of arg1 char within arg0
sub countChar {
    my $s = $_[0];
    $s =~ s/[^$_[1]]//g;
    return(length($s));
}

# Turn a string into a valid XML name.
sub fixName {
    (my $name = $_[0]) =~ s/[^-:_a-zA-Z0-9.]/_/g;
    if ($name eq "" or index("0123456789.-_:",substr($name,0,1))>=0) {
        $name = "A.$name";
    }
    return($name);
}

# Write start/end tags with optional indentation by level
sub startTag {
    $level++;
    print ($olineends) if ($indent);
    print ($indents x $level) if ($indent);
    print "<$_[0]" . (($_[1]) ? " $_[1]":"") . ">";
}
sub endTag {
    $level--;
    #print ($indents x $level) if ($indent);
    print "</$_[0]>";
    if ($_[1]) { print $olineends; }
    #print ($olineends) if ($indent);
}

# Escape special XML characters and print
sub arrangeContent {
    (my $out = $_[0]) =~ s/&/$ampEntity/g;
    $out =~ s/</$ltEntity/g;
    chomp($out);
    $out =~ s/^\s*$/$empty/;
    $out =~ s/^\s+//;
    $out =~ s/\s+$//;
    #($verbose) && warn "content: from '$_[0]' to '$out'\n";
    #if ($indent) { $out = ($indents x $level) . $out; }
    return $out;
}


################################################################################


sub showUsage {
    print "
Usage: tab2xml [options] fieldname1 fieldname2...
    Splits each line of stdin into fields, and tags each field.
    Tag names can be listed, or taken from the first record using '-header'.
    Also escapes lt and amp in the output as needed.
    Can generate field-delimited non-XML output as well (see -nonxml option).
Input format options:
    -comments     Treat lines beginning with \\s*\# as comments
    -delim regex  A Perl regex defining field separators (default '$dft_delim').
    -escape ch    What char escapes the quote char (none)? (for MS .csv, use '\"')
    -header       Interpret the first record as a list of field names.
    -lineends t    Assume input line-end sequences as for Dos, Mac, or Unix.
    -msq          Handle the way Excel quotes newlines (experimental).
    -quote ch     What char is used to quote input fields (none)?
    -norm         Normalize whitespace.
XML output markup options:
    -empty 's'    What to put in empty 'cells' (default '$dft_empty').
    -names '...'  A list of space-separated field-names to use (you'll probably
                  also want to set -record (see below).
        If you set -header but not -names, the header names will be used.
        If neither, HTML names will be used unless overriden with:
    -class        Put the field-names on class attribute instead of as tags.
    -id 'prefix'  Put an ID on each row, as prefix_ plus the row number.
    -root name    The element type for: the root element ('table')
    -record name                        each record ('tr')
    -field name                         each field in a record ('tr')
    -heading                            each field in the header record ('th')
    -table 'string'  Attribute string to insert on table root element.
XML layout options:
    -indent       Indents the output file.
    -is 's'       String to repeat for each indent level ('   ' = 3 spaces).
    -public p     Public identifier for the DOCTYPE (if any).
    -system s     System identifier for the DOCTYPE (if any)
                      (if no -public or -system, no DOCTYPE is generated).
    -x            Include an XML declaration.
    -numerics f   Use numeric entities rather than lt/amp. 'f' gives format:
                      99999 = 5 decimal digits (more if needed), zero-padded
                      x = 1 hexadecimal digit (more if needed), lower case
                      XXX = 3 hexadecimal digits (more if needed), upper case.
Non-XML output options:
    -nonxml       Generate other than XML output, as defined by:
    -ocomments, -odelim, -oescape, -oheader, -olineends, -oquote: see
         descriptions for corresponding input options (without the 'o')
    -oqwhere      Which output fields to quote: none/all/num/text/delim2
                      (default=delim: just quote fields that include delim).
General options:
    -nfields n    Require this number of fields, terminate on error.
    -overflow x   What to do with fields beyond those named by -header or -names:
                      fatal(default), discard, flag (as HTML, with class='???')
    -q            Suppress most messages.
    -v            Add more detailed messages (to stderr).
    -version      Display version info and exit ($version, sjd).
Related commands:
    align: split lines into fields, and pad to line up.
    makeHTMLtable, paste.
";
}