#!/usr/local/bin/perl -w
# Extract examples from an HTML document
#
# extract the content of the blocks:
#  <div class="example"> ... </div>
# and put their contents into separate files
#
# Arnaud Le Hors - lehors@w3.org
# $Id: xextr,v 1.7 2006-10-09 18:55:53 ihickson Exp $

$PROGNAME = substr($0, rindex($0, "/") + 1);

if (!$ARGV[0]) {
    print "Usage: $PROGNAME file [tgt_dir]\n";
    exit 1;
}

# copy file in memory
if (!open(INPUT, $ARGV[0])) {
    print "$PROGNAME Error: Cannot open file: $ARGV[0]\n";
    exit 1;
}
$buf = "";
while (<INPUT>) {
    $buf .= $_;
}
close(INPUT);

$path = "";
if ($ARGV[1]) {
    $path = "$ARGV[1]";
}

@paths = split(/\//, $ARGV[0]);
$path .= "/" . $paths[$#paths] . "_xampl";

sub process_html_block {
    my ($file, $block, $deprecated) = @_;

    # comment out undesired block
    $block =~ s/<em>(.*?)<\/em>/<!-- $1 -->/sigo;

    # map characters
    $block =~ s/&lt;/</g;
    $block =~ s/&gt;/>/g;
    $block =~ s/&quot;/\"/g;
    $block =~ s/&copy;/(C)/g;
    $block =~ s/&amp;/\&/g;

    # make sure it does form a complete document
    if (!($_ = $block, /<!doctype/i)) {
	if (($_ = $block, /frameset/i)) {
	    $doctype =
		"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Frameset//EN\">";
	} elsif ($deprecated || ($_ = $block, /noframe|iframe/i)) {
	    $doctype =
		"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">";
	} else {
	    $doctype = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">";
	    if (!($_ = $block, /<head>/i) &&
		(substr($block, 0, 1) ne "<" ||
		 substr($block, 0, 2) eq "<!" ||
		 substr($block, 0, 2) eq "<?")) {
		$block = "<p>\n$block";
	    }
	}
	$block = "$doctype\n$block";
    }
    if (!($_ = $block, /<title>/i)) {
	if (!($_ = $block, /<head>/i)) {
	    $block =~ s/<!doctype.*?>/$&\n<title>example<\/title>/i;
	} else {
	    $block =~ s/<head>/<head>\n<title>example<\/title>/i;
	}
    }

    # print file out
    print "\tHTML extracting $file\n";
    open(OUTPUT, "> $file") || die "failed to create $file\n";
    print OUTPUT $block;
    close(OUTPUT);
}

sub process_xml_block {
    my ($file, $block, $deprecated) = @_;

    # comment out undesired block
    $block =~ s/<em>(.*?)<\/em>/<!-- $1 -->/sigo;

    # map characters
    $block =~ s/&lt;/</g;
    $block =~ s/&gt;/>/g;
    $block =~ s/&quot;/\"/g;
    $block =~ s/&copy;/(C)/g;
    $block =~ s/&amp;/\&/g;

    # print file out
    print "\tXML extracting $file\n";
    open(OUTPUT, "> $file") || die "failed to create $file\n";
    print OUTPUT $block;
    close(OUTPUT);
}

sub process_css_block {
    my ($file, $block, $deprecated) = @_;

    # comment out undesired block
    $block =~ s|<em>(.*?)</em>|/* $1 */|sigo;

    # map characters
    $block =~ s/&lt;/</g;
    $block =~ s/&gt;/>/g;
    $block =~ s/&quot;/\"/g;
    $block =~ s/&copy;/(C)/g;
    $block =~ s/&amp;/\&/g;

    # print file out
    print "\tCSS extracting $file\n";
    open(OUTPUT, "> $file") || die "failed to create $file\n";
    print OUTPUT $block;
    close(OUTPUT);
}


# Extract different types of blocks: css, html, xml.
# If the type is "html" or "xml" at the DIV level,
# assume that *all* pre elements within are "html" or
# "xml" respectively. If the type is unknown,
# assume css, but allow internal pre elements to
# override this.

sub get_lang {
    $pattern =$_[0];
    if ( $pattern =~ /html/io ){
	return "html";
    } elsif ( $pattern =~ /xml/io ){
	return "xml";
    } else {
	return "css";
    }
}

sub process_pre_block {
    ($preclass, $preblock) = @_;
    $lang = get_lang($preclass);
    $output = "$path$num.$subnum.$lang";
    $deprecated = ($preclass =~ /deprecated/io) ? 1 : 0;
    if ($lang eq "html") {
	process_html_block("$output", $preblock, $deprecated);
    } elsif ($lang eq "xml") {
	process_xml_block("$output", $preblock, $deprecated);
    } elsif ($lang eq "css") {
	process_css_block("$output", $preblock, $deprecated);
    } else {
	warn "Unknown language $lang";
    }
}



$preblockst = "(?:<pre>|(?:<pre\\s+class\\s*=\\s*\"?(example|deprecated-example|html-example|deprecated-html-example|xml-example|deprecated-xml-example)\"?\\s*>))\n?";
$preblocket = "\n?<\/pre>";

# Arguments: 
# 0: DIV class value
# 1: DIV content
sub process_pre_blocks {
    ($divclass, $divcontent) = @_;
    while ($divcontent =~ /$preblockst(.*?)$preblocket/iso) {
	$subnum++;
	process_pre_block(($1 || $divclass), $2);
	$divcontent = $'
	}
}

$divblockst = "<(div|pre)\\s+class\\s*=\\s*\"?(example|deprecated-example|html-example|deprecated-html-example|xml-example|deprecated-xml-example)\"?\\s*>\n?";
$divblocket = "\n?<\/\\1>";

$_ = $buf;
$num = 0;
$subnum = 0;

while (/$divblockst(.*?)$divblocket/iso) {
    $continue = $';
    $element = $1;
    $class = $2;
    $block = $3;
    $num++;
    $subnum = 0;
    # If DIV, process internal PRE blocks, 
    # otherwise, process PRE block directly.
    if ($element =~ /div/io) {
	process_pre_blocks($class, $block);
    } else {
	process_pre_block($class, $block);	
    }
    $_ = $continue;
}
