#!/usr/bin/perl

# This is a basic starter template script for processing your xml. There are some
# very basic checks at the beginning that will apply to most xml but you may need
# to alter these checks if your xml deviates too much from the norm.


use utf8;
use strict;
binmode(STDIN, ":utf8");
binmode(STDOUT, ":utf8");


# Please be sure to set the following four variables correctly for your book.

my $BOOK_ID = "pel4e";
my $PUBLISHER = "fw"; # set this to either "bsm" or "fw"
# Set this to 1 if you want the new page number checking, otherwise 0.
# If your book does not have page numbers definitely set this to 0.
my $ENABLE_PAGE_NUMBER_CHECKING = 1;
# Set this to 1 to fix up linebreaks for dashes (see fix_linebreaks function below), otherwise 0.
# This is highly recommended but if it is causing too many problems then set to 0.
my $FIX_LINEBREAKS = 1;


my $CHAPTER;
my $CHAPTER_TITLE;
my $TM = "";
my $CTcounter = 0;
my %review = ();
my %test = ();
my %terms = ();
my %answers = ();

# PAGE NUMBERS begin
my $LAST_PAGE; # last page number seen in section
my %PAGE_NUMBERS;
my %PRINT_PAGE;
my %PAGE_START;
# PAGE NUMBERS end

# Use '_NL_' to specify newlines (such as for question formatting)
my $NEWLINE = "_NL_";

if ($BOOK_ID eq "") {
    print STDERR "Please set the BOOK_ID variable in this script\n";
    exit();
}
if ($PUBLISHER ne "bsm" && $PUBLISHER ne "fw") {
    print STDERR "Please set the PUBLISHER variable in this script to either 'bsm' or 'fw'\n";
    exit();
}

print STDERR "BOOK_ID: $BOOK_ID\n";
print STDERR "PUBLISHER: $PUBLISHER\n";

my $contents;
my $temp_line;
while ($temp_line = <STDIN>) {
    chomp($temp_line);

    $temp_line =~ s`<\?xml [^>]+>``g;
    $temp_line =~ s`<(\/)?manuscript( [^>]+)?>``g;

    $temp_line =~ s/[\t\r\n]//g; #remove tabs, line feeds, returns
    $temp_line =~ s/[ ]{2,}/ /g; # remove multiple spaces
    $temp_line =~ s/^\s+//; # remove leading spaces
    $contents .= $temp_line;
}


# If you want to "remove" content from your xml without actually deleting it from
# the file, wrap it in <rm>...</rm>
# WARNING: do not embed <rm> tags inside of <rm> tags!
$contents =~ s`<rm>.*?</rm>``g;

# Fix up any title attributes that have inline tags
$contents =~ s` title="([^"]+)"`" title=\"" . fix_title($1) . "\""`ge;

# Change <tag> to {tag}
sub fix_title {
    my $title = shift;
    $title =~ s`<([^>]+)>`{$1}`g;
    return $title;
}


$_ = $contents;


# At this point, the xml from the file is now one big string with no newlines


# Get chapter info/check for start-numbering-at
s`<chapter ([^>]+)>`"<chapter " . get_chapter_info($1) . ">"`e;

sub get_chapter_info {
    my $tag = shift;

    ($CHAPTER_TITLE) = $tag =~ /title="([^"]+)"/;
    ($CHAPTER) = $tag =~ /number="(?:ch)?(?:[0]+)?(\d+)"/i;

    if ($CHAPTER_TITLE eq "") {
	print STDERR "Can't find chapter title\n";
	exit();
    }
    if ($CHAPTER eq "") {
	print STDERR "Can't find chapter number\n";
	exit();
    }

    # If chapter does not have start-numbering-at attribute then add it
    if ($tag !~ /start-numbering-at/) {
	$tag .= qq` start-numbering-at="${CHAPTER}"`;
    }
    # Otherwise, make sure start-numbering-at is the same as chapter number
    else {
	$tag =~ s`start-numbering-at="[^"]+"`start-numbering-at="${CHAPTER}"`;
    }

    return $tag;
}



### Uncomment the following lines if your vendor supplied IDs need fixing
### (i.e. they are not unique enough)
### The fix_id subroutine my also need fixing depending on the format of the IDs

#s`id="([^"]+)"`"id=\"" . fix_id($1) . "\""`ge;
#s`refid="([^"]+)"`"refid=\"" . fix_id($1) . "\""`ge;

sub fix_id {
    my $id = shift;

    if ($id !~ /^$BOOK_ID/) {
	return $BOOK_ID . "-ch" . $CHAPTER . "-" . $id;
    }

    return $id;
}

# PAGE NUMBERS begin
# Sometimes the vendor uses page-start instead of page_start
if ($ENABLE_PAGE_NUMBER_CHECKING) {
  s`block_type="page-start"`block_type="page_start"`g;
  # Fix page_start IDs
  s`<p ([^>]+)?block_type="page_start"([^>]+)?>(.*?)</p>`"<p id=\"${BOOK_ID}_page_${3}\" block_type=\"page_start\"${2}>${3}</p>" . add_page_start($3)`ge;
}

sub add_page_start {
    my $page = shift;
    $PAGE_START{$page} = 1;
    return "";
}
# PAGE NUMBERS end



#Read in Chapter Review Answers
open my $reviewfile, '<', 'pel4e_appd_ready.xml' 	or die "Can't open < pel4e-appd_ready.xml: $!";
chomp(my @reviewlines = <$reviewfile>);
close $reviewfile;
foreach (@reviewlines) {
	my @rparts = split(/<\/strong><\/p>/, $_);
	my ($reviewid) = @rparts[0] =~ /<strong>([^<]+)<\/strong>/;
	my ($reviewans) = @rparts[1];
	#$reviewans =~ s`block_type="bluebullet"`block_type="answer" data-show-answer="this"`;
	$review{"$reviewid"} = $reviewans;
}
#print STDERR $review{"A-2"} . "\n";

#Read in Chapter Test Answers
open my $testfile, '<', 'pel4e-appe_ready.xml' 	or die "Can't open < pel4e-appe_ready.xml: $!";
chomp(my @testlines = <$testfile>);
close $testfile;
foreach (@testlines) {
	my ($testid) = $_ =~ /pel4e-app5-sec1-(\d+)/;
	my ($testline) = $_;
	if($testid == $CHAPTER) {
		my @tparts = split(/<li>/, $testline);
		foreach (@tparts) {
			my ($testanswer) = $_ =~ /<p [^>]+>(.*)<\/p>/;
			$test{$CTcounter} = $testanswer;
			$CTcounter++;
		}
	}
}
$CTcounter = 2;


#Read in Glossary
open my $glossfile, '<', 'terms.js';
chomp(my @glosslines = <$glossfile>);
close $glossfile;
foreach (@glosslines) {
	my @aparts = split(/'/, $_);
	#if ($_ =~ /xBookUtils.terms[\'([^\']+)\'] = \'([^\']+)\';/) {
		#$answers{$1} = $2;
	#}
	$terms{@aparts[1]} = @aparts[3];
}


# BEGINNING THE PROCESS FUNCTIONS
# This script is designed to cycle through all the major elements in the xml file.
# For each element there is a corresponding "process" function where you can add your
# custom code.

#eliminate c-heads
s`</section><section (id="[^"]+") [^>]+ title=""[^>]* level="3"[^>]*><section-metadata><section-title>(.*?)</section-title></section-metadata>`<rawhtml>&lt;h4 $1 class="level4"&gt;$2&lt;/h4&gt;</rawhtml>`g;

# Take care of these empty level 1 and 2 sections
s`(<section-metadata><section-title>.*?</section-title></section-metadata>)(<p id="[^"]+" block_type="page_start">\d+</p>)?</section><section id="([^"]+)"[^>]+level="2"([^>]+)?><section-metadata><section-title>(.*?)</section-title></section-metadata>`\1\2<p id="\3" block_type="h2_force">\5</p>`g;
#s`(<section-metadata><section-title>.*?</section-title></section-metadata>)<section id="([^"]+)"[^>]+level="3"([^>]+)?><section-metadata><section-title>(.*?)</section-title></section-metadata>`\1<p id="\2" block_type="h3_force">\4</p>`g;

# "pre-process" sections
# Anything you need to do to a section before you begin processing the elements
# within that section goes in the pre_process_section function
s`<section ([^>]+)>(.*?)</section>`pre_process_section($1, $2)`ge;

# PAGE NUMBERS begin
if ($ENABLE_PAGE_NUMBER_CHECKING) {
  check_page_numbers();
}

sub check_page_numbers {
    my $num;
    my $prev_page;
    my $error = 0;
    my $first;
    my $last;

    foreach $num (sort {$a<=>$b} keys %PRINT_PAGE) {
        if (!exists($PAGE_START{$num})) {
            print STDERR "ERROR: no page_start found for page $num\n";
        }
    }

    foreach $num (keys %PAGE_NUMBERS) {
        # first get rid of all non-numeric page numbers
        if ($num !~ /^\d+$/) {
            delete($PAGE_NUMBERS{$num});
        }
    }
    # now go through them and make sure we aren't missing any
    foreach $num (sort {$a<=>$b} keys %PAGE_NUMBERS) {  
        if ($prev_page eq "") {
            # do nothing, this is the first page_start number
            $first = $num;
        }
        # if we skipped one page
        elsif ($num == ($prev_page + 2)) {
            print STDERR "ERROR: no page_start found for page " . ($prev_page + 1) . "\n"; 
            $error = 1;
        }
        elsif ($num > ($prev_page + 2)) {
            print STDERR "ERROR: " . (($num - $prev_page) - 1) . " page_start numbers missing between " . $prev_page . " and " . $num . "\n";
            $error = 1;
        }  
        $prev_page = $num;
        $last = $num;
    }
    
    if (!$error && $first && $last) {
        print STDERR "INFO: Consecutive print_page numbers found from $first to $last\n";
    }
}
	print STDERR "\n";
# PAGE NUMBERS end

# process boxes
# put all of your box processing code in the process_box function
my $BOX_COUNT = 0;
while (/(<box [^>]+>)/) {
    s`<box ([^>]+)>((?:(?!<box ).)*?)</box>`process_box($1, $2)`ge;
    $BOX_COUNT++;
    if ($BOX_COUNT > 1000) {
	print STDERR "Too many boxes ...\n";
	print STDERR $1, "\n";
	exit(0);
    }
}
# these are important, don't remove them
s`<boxer `<box `g;
s`</boxer>`</box>`g;


# process paras
# put all of your para processing code in the process_para function
s`<p ([^>]+)>(.*?)</p>`process_para($1, $2)`ge;


# process figures
# put all of your figure processing code in the process_figure function
s`<figure ([^>]+)>(.*?)</figure>`process_figure($1, $2)`ge;

# MB
# process questions
# put all of your question processing code in the process_question function
s`<question ([^>]+)>(.*?)</question>`process_question($1, $2)`ge;

# process lists
# put all of your list processing code in the process_list function
my $LIST_COUNT = 0;
while (/(<list [^>]+>)/) {
    s`<list ([^>]+)>((?:(?!<list ).)*?)</list>`process_list($1, $2)`ge;
    $LIST_COUNT++;
    if ($LIST_COUNT > 1000) {
	print "Too many lists ...\n";
	exit(0);
    }
}
# these are important, don't remove them
s`<lister `<list `g;
s`</lister>`</list>`g;


# process tables
# put all of your table processing code in the process_table function
my $TABLE_COUNT = 0;
while (/(<table [^>]+>)/) {
    s`<table ([^>]+)>((?:(?!<table ).)*?)</table>`process_table($1, $2)`ge;
    $TABLE_COUNT++;
    if ($TABLE_COUNT > 1000) {
	print "Too many tables ...\n";
	exit(0);
    }
}
# these are important, don't remove them
s`<tabler `<table `g;
s`</tabler>`</table>`g;


# post process section
# Anything you need to do to a section after you have processed the elements
# within that section goes in the post_process_section function
s`<section ([^>]+)>(.*?)</section>`post_process_section($1, $2)`ge;

# convert tags in rawhtml for DF
s`<rawhtml>(.*?)</rawhtml>`"<rawhtml>" . fix_up_rawhtml($1) . "</rawhtml>"`ge;

# add new lines back in to xml
s`(<(rawhtml|chapter|section|box|layout|table|tbody|tr|list|figure|layout|question|image|asset_source)(/| [^>]+)?>)`\1\n`g;
s`(</(metadata|p|div|table|tr|td|list|li|box|question|query|tbody|th|rawhtml|caption|figure|section-metadata)>)`\1\n`g;
s`</section>`</section>\n`g;
s`</rawhtml>`\n</rawhtml>`g;


# restore newlines
s`${NEWLINE}`\n`g;


### print out the xml ###

print $_, "\n";


sub fix_up_rawhtml {
    my $text = shift;
    $text =~ s`<`&lt;`g;
    $text =~ s`>`&gt;`g;
    return $text;
}



sub pre_process_section {
    my $args = shift; # attributes on the <section> tag
    my $content = shift; # content of section

    my ($section_id) = $args =~ /id="([^"]+)"/;
    
    # Fix title if there are inline tags (e.g. {em})
    if ($args =~ /title="([^"]+)"/ && $content !~ /<section-metadata>/) {
	my $title = $1;

	if ($title =~ /\{[^}]+\}/) {
	    $title =~ s`\{([^}]+)\}`<${1}>`g;
	    $content = "<section-metadata><section-title>${title}</section-title></section-metadata>" . $content;
	    $args =~ s`title="[^"]+"`title=""`;
	}
    }
    
    $args =~ s`title="Chapter Introduction"`title="Chapter ${CHAPTER} Introduction"`;

	$content =~ s`co(\d+) (.*?)\.jpg"`co\1_\2.jpg"`g;

	$content =~ s`<link href="pel4e-ch\d+\.xml">Chapter (\d+)</link>`<link href="pel4e_ch\1_1.html" target="_pop">Chapter&#160;\1</link>`g;
	$content =~ s`Chapter (\d+)`<link href="pel4e_ch\1_1.html" target="_pop">Chapter&#160;\1</link>`g;
	$content =~ s`Appendix A`<link href="pel4e_app1_1.html" target="_pop">Appendix&#160;A</link>`gi;
	$content =~ s`Appendix B`<link href="pel4e_app2_1.html" target="_pop">Appendix&#160;B</link>`gi;
	$content =~ s`Appendix C`<link href="pel4e_app3_1.html" target="_pop">Appendix&#160;C</link>`gi;
	$content =~ s`<link href="pel4e_app\d_1.html" target="_pop">Appendix&#160;([A-D])</link> ([REVIEW|TEST])`Appendix \1 \2`gi;

	# Getting rid of Appendix D
	$content =~ s`Then turn to Appendix D, Complete Chapter Reviews, to check your answers. ``g;
	
    # PAGE NUMBERS begin
    # Process the page numbers in the section, adding the print_page
    # attribute if needed
    if ($ENABLE_PAGE_NUMBER_CHECKING) {
      if ($content =~ /^(<section-metadata>.*?<\/section-metadata>)?<p ([^>]+)?block_type="page_start"([^>]+)?>(.*?)<\/p>/) {
        $LAST_PAGE = $4;
        $args =~ s`\s*print_page="[^"]*"``;
        $args .= qq` print_page="${LAST_PAGE}"`;
	#print STDERR "NOTICE: section ID $section_id is at the beginning of page $LAST_PAGE, setting print_page to $LAST_PAGE\n";
      }
      
      my ($print_page) = $args =~ /print_page="([^"]+)"/;
      
      # If print_page does not exist then set it to LAST_PAGE 
      if ($print_page eq "") {
        if ($LAST_PAGE ne "") {
	  $args =~ s`\s*print_page="[^"]*"``;
	  $args .= qq` print_page="${LAST_PAGE}"`;
	  $print_page = $LAST_PAGE;
	  #print STDERR "NOTICE: section ID $section_id did not have print_page attribute, setting to ${LAST_PAGE}\n";
        }
        else {
	  print STDERR "ERROR: section ID $section_id does not have print_page set\n";
        }
      }
      else {
        # print_page was included in XML - if we don't have a page_start for the 
        # print_page then assume this is the beginning of a new page and add it
        if (!exists($PAGE_START{$print_page})) {
	  if ($content =~ /<\/section-metadata>/) {
	    $content =~ s`</section-metadata>`</section-metadata><p id="${BOOK_ID}_page_${print_page}" block_type="page_start">${print_page}</p>`;
	  }
	  else {
	    $content = "<p id=\"${BOOK_ID}_page_${print_page}\" block_type=\"page_start\">${print_page}</p>" . $content;
	  }
	  add_page_start($print_page);
	  $LAST_PAGE = $print_page;
        }
      }
      
      if ($print_page ne "") {
        $PRINT_PAGE{$print_page} = 1;
      }
      
      # Theoretically, the print_page attribute should match up with LAST_PAGE, but there
      # may be instances where it doesn't so don't fix, just send a warning
      if ($print_page ne "" && $LAST_PAGE ne "" &&  $print_page ne $LAST_PAGE) {
        print STDERR "WARNING: section ID $section_id has possible bad print_page (current = $print_page, possibly should be $LAST_PAGE)\n";
      }
    }
    # PAGE NUMBERS end


    # Your custom code goes below

	$content =~ s`co1 gettyimages`co1_gettyimages`g;
	
	$args =~ s`numbered="true"`numbered="false"`;
	
	#Add the proper path to images *MB*
	$content =~ s` src="images/` src="`g;
	$content =~ s` src="([^.]+).jpg"` src="asset/img_ch${CHAPTER}/\1.jpg"`g;
	$content =~ s` src="asset/img_ch\d+/launchpad(1)?.jpg` src="asset/pics/launchpad\1.jpg`g;
	$content =~ s` src="asset/img_ch\d+/learni(n)?gcurve.jpg` src="asset/pics/learningcurve.jpg`g;
	$content =~ s`<p id="([^"]+)" block_type="co-toc-t"><strong>SURVEY THE</strong> <phrase block_type="co-toc-t-v1"><strong>CHAPTER</strong></phrase>`<p id="\1" block_type="co-toc-t"><strong>SURVEY THE</strong></p><p id="\1-2" block_type="co-toc-t-v1"><strong>CHAPTER</strong>`;

	$content =~ s`<phrase block_type="lo-n-ri"><strong>LOQ (\d+-\d+)</strong></phrase>`<phrase block_type="lo-n-ri"><strong><phrase block_type="LOQ_orange">L</phrase><phrase block_type="LOQ_green">O</phrase><phrase block_type="LOQ_blue">Q</phrase> \1</strong></phrase>`g;
	$content =~ s`<strong>LOQ LearningObjectiveQuestion`<strong><phrase block_type="LOQ_orange">L</phrase><phrase block_type="LOQ_green">O</phrase><phrase block_type="LOQ_blue">Q</phrase> <phrase block_type="LOQ_orange_space">L</phrase>earning<phrase block_type="LOQ_green_space">O</phrase>bjective<phrase block_type="LOQ_blue">Q</phrase>uestion`g;
	$content =~ s`<strong>LOQ`<strong><phrase block_type="LOQ_orange">L</phrase><phrase block_type="LOQ_green">O</phrase><phrase block_type="LOQ_blue">Q</phrase>`g;
	$content =~ s`</strong> <phrase block_type="lo-n-ri"><strong>` </strong><phrase block_type="lo-n-ri"><strong>`g;
	$content =~ s`</phrase></strong> <strong>`</phrase> `g;
	
	$content =~ s`(<strong>)?<link href="[^"]+">(<strong>)?TABLE (\d+).(\d+)(</strong>)?</link>(</strong>)?`<phrase block_type="table_link"><link href="asset/table/table_\3_\4.html" data-target="_pop">TABLE&#160;\3.\4</link></phrase>`ig;
	$content =~ s`(<strong>)?<link [^>]+>(<strong>)?TABLE ([A-Z]).(\d+)(</strong>)?</link>(</strong>)?`<phrase block_type="table_link"><link href="asset/table/table_\l\3_\4.html" data-target="_pop">TABLE&#160;\3.\4</link></phrase>`ig;
	$content =~ s`link href="pel4e-ch\d+.xml#pel4e-ch(\d+)-tab-(\d+)"`link href="asset/table/table_\1_\2.html" data-target="_pop"`ig;
	$content =~ s`link href="pel4e-ch\d+.xml#pel4e-app([a-z])-tab-(\d+)"`link href="asset/table/table_\1_\2.html" data-target="_pop"`ig;

	#FOOTNOTES
	$content =~ s`<link target="fn\d+" href="[^"]+"><sup>(\d+)</sup></link>`<termref term="fn_${CHAPTER}_\1"><sup>\1</sup></termref>`g;

	#CHAPTER REVIEW SECTIONS
	$content =~ s`<section-metadata><section-title>CHAPTER REVIEW</section-title></section-metadata><p id="[^"]+" block_type="sum-t"><strong>(.*?)</strong></p>`<section-metadata><section-title>CHAPTER REVIEW: \1</section-title></section-metadata>`;
	$content =~ s`<section-metadata><section-title>CHAPTER REVIEW: (.*?)</section-title></section-metadata>`<section-metadata><section-title><phrase block_type="chapter_review">Chapter ${CHAPTER} Review</phrase></section-title></section-metadata><p id="chapter_${CHAPTER}_review"><phrase block_type="chapter_review_title">\1</phrase></p>`;

		
	#IN YOUR EVERYDAY LIFE SECTIONS
	$content =~ s`<section-metadata><section-title>IN YOUR EVERYDAY LIFE</section-title></section-metadata>`<section-metadata><section-title><phrase block_type="everyday_life">Chapter ${CHAPTER} In Your Everyday Life</phrase></section-title></section-metadata>`;

	#CHAPTER TEST SECTIONS
	$content =~ s`<section-metadata><section-title>CHAPTER TEST</section-title></section-metadata>`<section-metadata><section-title><phrase block_type="chapter_test">Chapter ${CHAPTER} Test</phrase></section-title></section-metadata>`;

	
	#TERMS
	$content =~ s`<link href="[^"]+">(.*?), p. (\d+)</link>`<termref term="\1">\1, p. \2</termref>`g;
	$content =~ s`<link href="[^"]+">(.*?), p. [A-Z]-(\d+)</link>`<termref term="\1">\1, p. \2</termref>`g;
	$content =~ s`<section-metadata><section-title>TERMS AND CONCEPTS TO REMEMBER</section-title></section-metadata>`<section-metadata><section-title>Chapter ${CHAPTER} Terms and Concepts to Remember</section-title></section-metadata>`;
		
    # PAGE NUMBERS begin
    # Last thing to do - set $LAST_PAGE
    if ($ENABLE_PAGE_NUMBER_CHECKING) {
      if ($args =~ /print_page="([^"]+)"/) {
        $LAST_PAGE = $1;
      }
      $content =~ s`(<p .*?block_type="page_start".*?>(.*?)</p>)`$1 . set_last_page($2, $section_id)`ge;
    }
    # PAGE NUMBERS end

    return qq`<section ${args}>${content}</section>`;
}

# PAGE NUMBERS begin
# Set the LAST_PAGE variable (only page_starts should be passed into this)
sub set_last_page {
    my $page = shift;
    my $sec_id = shift;

    if ($LAST_PAGE =~ /^\d+$/ && $page =~ /^\d+$/) {
	if ($page < $LAST_PAGE) {
	    print STDERR "WARNING: page_start number $page falls after page_start number $LAST_PAGE in section ID $sec_id\n";
	}
    }

    if (exists($PAGE_NUMBERS{$page})) {
	if ($PAGE_NUMBERS{$page} ne $sec_id) {
	    print STDERR "ERROR: Duplicate page_start number $page in sections $sec_id and $PAGE_NUMBERS{$page}\n";
	}
	else {
	    print STDERR "ERROR: Duplicate page_start number $page in section $sec_id\n";
	}
    }
    else {
	$PAGE_NUMBERS{$page} = $sec_id;
	$LAST_PAGE = $page;
    }
    
    return "";
}
# PAGE NUMBERS end

sub post_process_section {
    my $args = shift; # attributes on <section> tag
    my $content = shift; # content of section

    # move term boxes up one para by default
    $content =~ s`(<p [^>]+>(?:(?!<p ).)*?</p>)(<box [^>]+ block_type="term">.*?</box>)`\2\1`g;

    # Fix title if there are inline tags
    if ($args =~ /title="[^"]+"/ && $content !~ /<section-metadata>/) {
	my $title = $1;
	if ($title =~ /<[^>]+>/) {
	    $content = "<section-metadata><section-title>${title}</section-title></section-metadata>" . $content;
	    $args =~ s`title="[^"]+"`title=""`;
	}
    }

	$content =~ s`</link>([.,:;\?])</strong>`</link></strong>\1`g;

	$content =~ s`(<strong>)?<link href="[^"]+">FIGURE (\d+).([1-9])([a-z]?)</link>(</strong>)?`<phrase block_type="figure_link"><link href="asset/img_ch\2/myerspel4e_fig_\2_0\3.html" data-target="_pop">FIGURE&#32;\2.\3\4</link></phrase>`ig;
	$content =~ s`(<strong>)?<link href="[^"]+">FIGURE (\d+).(\d+)([a-z]?)</link>(</strong>)?`<phrase block_type="figure_link"><link href="asset/img_ch\2/myerspel4e_fig_\2_\3.html" data-target="_pop">FIGURE&#32;\2.\3\4</link></phrase>`ig;
    $content =~ s`(<strong>)?FIGURE (\d+)\.([1-9])([a-z]?)(</strong>)?`<phrase block_type="figure_link"><link href="asset/img_ch\2/myerspel4e_fig_\2_0\3.html" data-target="_pop">FIGURE&#32;\2.\3\4</link></phrase>`gi;
	$content =~ s`(<strong>)?FIGURE (\d+)\.(\d+)([a-z]?)(</strong>)?`<phrase block_type="figure_link"><link href="asset/img_ch\2/myerspel4e_fig_\2_\3.html" data-target="_pop">FIGURE&#32;\2.\3\4</link></phrase>`gi;
	
	$content =~ s`(<strong>)?<link href="[^"]+">FIGURE ([A-Z]?).([1-9])([a-z]?)</link>(</strong>)?`<phrase block_type="figure_link"><link href="asset/img_ch${CHAPTER}/myerspel4e_fig_app_\l\2_0\3.html" data-target="_pop">FIGURE&#32;\2.\3\4</link></phrase>`ig;
	$content =~ s`(<strong>)?<link href="[^"]+">FIGURE ([A-Z]?).(\d+)([a-z]?)</link>(</strong>)?`<phrase block_type="figure_link"><link href="asset/img_ch${CHAPTER}/myerspel4e_fig_app_\l\2_\3.html" data-target="_pop">FIGURE&#32;\2.\3\4</link></phrase>`ig;
    $content =~ s`(<strong>)?FIGURE ([A-Z]?)\.([1-9])([a-z]?)(</strong>)?`<phrase block_type="figure_link"><link href="asset/img_ch${CHAPTER}/myerspel4e_fig_app_\l\2_0\3.html" data-target="_pop">FIGURE&#32;\2.\3\4</link></phrase>`gi;
	$content =~ s`(<strong>)?FIGURE ([A-Z]?)\.(\d+)([a-z]?)(</strong>)?`<phrase block_type="figure_link"><link href="asset/img_ch${CHAPTER}/myerspel4e_fig_app_\l\2_\3.html" data-target="_pop">FIGURE&#32;\2.\3\4</link></phrase>`gi;

	
#	img_ch15/myerspel4e_fig_app_a_01.html
	
	
	$content =~ s`term="general intelligence([^"]+)"`term="general intelligence"`g;
	
	$content =~ s`<link href="pel4e[-_]ch(\d+).xml"( target="_pop")?>`<link href="pel4e_ch\1_1.html" target="_pop">`g;
	$content =~ s`<link href="pel4e[-_]ch(\d+)\_(\d+).xml"( target="_pop")?>`<link href="pel4e_ch\1_\2.html" target="_pop">`g;
	

    # Force browsers to line break correctly at dashes.
    # NOTE: This is still experimental.  Please let Bruce know if it
    # causes any problems.
    if ($FIX_LINEBREAKS) {
      $content = fix_linebreaks($content);
    }
	
	#remove dash and parens from termref
	$content =~ s`<termref term="([^"]+)">`process_nodash($1)`ge;
	$content =~ s`<termref term="([^"]+)">`<termref term="\1 ${CHAPTER}">`g;
	
	if ($args =~ /termsandconcepts/) {
		$content =~ s`, p. \d+</termref>`</termref>`g;
		$content =~ s`, p. A-\d+</termref>`</termref>`g;
		$content =~ s`flipping back to the referenced page`mousing over each term`;
	}
	
    return qq`<section ${args}>${content}</section>`;
}
sub process_nodash {
    my $termref = shift;
    $termref =~ s`-` `g;
	$termref =~ s|&#\d+;| |g;
	$termref =~ s` \([^)]+\)``g;
	$termref =~ s`[^A-Za-z0-9]` `g;
	$termref = lc $termref;
	$termref =~ s/^\s+|\s+$//g;
	if (!$terms{"$termref ${CHAPTER}"}) {
	    print STDERR "$termref\n";
	}
    return "<termref term=\"$termref\">";
}

sub process_question {
    my $args = shift; # attributes on <question> tag
    my $content = shift; # contents of figure
    my ($ques_num) = $args =~ /number="([^"]+)"/;
    
    $content =~ s`<p id="([^"]+)" block_type="sum-que-nl">`<p id="\1" block_type="sum-que-nl"><phrase block_type="ques_num">${ques_num}: </phrase>`;
    $content =~ s`<p id="([^"]+)" block_type="cr-que-nl([^"]+)?">`<p id="\1" block_type="cr-que-nl\2"><phrase block_type="test_ques_num">${ques_num}. </phrase>`;
	
	if ($content =~ /block_type="sum-que-nl"/) {
		my $ans = $review{$ques_num};
		$content =~ s`<p id="([^"]+)" block_type="answer" data-show-answer="this">ANSWER: THIS IS THE ANSWER</p>`<box id="\1" block_type="answer" data-show-answer="this">${ans}</box>`;
		$CTcounter++;
	}
	
	if ($content =~ /ANSWER: C. That one guy/) {
		my $ans = $test{$ques_num};
		$content =~ s`ANSWER: C. That one guy`${ans}`;
		$CTcounter++;
	}

    return qq`<question ${args}>${content}</question>`;
}    

sub process_figure {
    my $args = shift; # attributes on <figure> tag
    my $content = shift; # contents of figure

	my ($fig_id) = $args =~ /id="([^"]+)"/;
	
	$args =~ s`block_type="figure" numbered="false" number="false"`block_type="un_figure" numbered="false" number="false"`;
	if ($args =~ /id="pel4e-ch\d+-fig-1"/) {
		$content =~ s`align="center"`align="right"`;
		$args =~ s`block_type="un_figure"`block_type="intro_figure"`;
	}
	
	$content =~ s`block_type="fig-label"><strong>FIGURE `block_type="fig-label"><strong>FIGURE&#32;`;
	
	$content =~ s`<caption><strong>(.*?)</strong>`<caption><phrase block_type="fig_title">\1</phrase>`;
	
	$content =~ s`align="right" width="large"`align="right" width="medium"`;
	

    # Create supp html files for figures
    my ($img_file_no_ext) = $content =~ /src="(?:[^"]+\/)?(.*?)\.(?:jpg|gif|png|tiff)"/;
    create_supp_file("figure", $img_file_no_ext, $args, $content);

    return qq`<figure ${args}>${content}</figure>`;
}



sub process_list {
    my $args = shift; # attributes on <list> tag
    my $content = shift; # contents of list

	# get <p> tags out of <li>'s
	#$content =~ s`<li><p [^>]+>(.*?)</p></li>`<li>\1</li>`g;


    # yes, we are returning "lister"
    return qq`<lister ${args}>${content}</lister>`;
}


sub process_table {
    my $args = shift; # attributes on <table> tag
    my $content = shift; # contents of table
	#my ($tab_num) = $content =~ /TABLE [A-Z]|\d+\.(\d+)/;
	#my ($tab_ch) = $content =~ /TABLE ([A-Z]|\d+)\.\d+/;
	#my ($tab_num2) = $args =~ /pel4e-[^-]+-tab-(\d+)/;
	
	# process each <td>
    $content =~ s`(<td[^>]*>.*?</td>)`process_td($1)`ge;
	
	$args =~ s`caption-placement="top"`caption-placement="Top"`; 
	
	if ($content =~ /TABLE (\d+).(\d+)/) {
		$args .= " data-href=\"asset/table/table_$1_$2.html\" data-target=\"_pop\"";
	} elsif ($content =~ /TABLE&#160;([A-Z]).(\d+)/) {
		my $tab_ch = lc($1);
		$args .= " data-href=\"asset/table/table_${tab_ch}_$2.html\" data-target=\"_pop\"";
	} elsif ($content =~ /TABLE \d+/) {
		my ($tab_num2) = $args =~ /pel4e-[^-]+-tab-(\d+)/;
	#	$tab_num = $args =~ /pel4e-[^-]+-tab-(\d+)/;
		$args .= " data-href=\"asset/img_ch${CHAPTER}/table_${tab_num2}.html\" data-target=\"_pop\"";
	}

	$content =~ s`(<table_caption><strong><phrase block_type="tab-label">TABLE \d+.\d+</phrase></strong>) (.*?)</table_caption>`\1 <phrase block_type="tab-title">\2</phrase></table_caption>`;

    # Create table supp html files for numbered tables.  You may need to adjust
    # the regex for your particular xml.
    if ($content =~ /<table_caption><strong><phrase block_type="tab-label">(TABLE \d+.\d+)/) {
	my $table_file_no_ext = $1;
	$table_file_no_ext = lc($table_file_no_ext);
	$table_file_no_ext =~ s`[ \-\.]`_`g;
	create_supp_file("table", $table_file_no_ext, $args, $content);
    }

    # yes, we are returning "tabler"
    return qq`<tabler ${args}>${content}</tabler>`;
}


sub process_td {
    my $td = shift;

	if ($td =~ /tbn-colhd/) {
		$td =~ s`<td><phrase block_type="tbn-colhd">(.*?)</phrase></td>`<th>\1</th>`;
	}

    return $td;
}


sub process_box {
    my $args = shift; #attributes on <box> tag
    my $content = shift; # contents of box
    
    my ($box_type) = $args =~ /block_type="([^"]+)"/;

	my ($box_title) = $args =~ /title="([^"]+)"/;

	if ($box_title eq "Retrieve &#43; Remember"){
		$args =~ s`title="Retrieve &#43; Remember"`title=""`g;
		$content =~ s`block_type="sr-h"`block_type="sr-que-bl"`g;
		$content = "<box-metadata><box-title><phrase block_type=\"ret_rem\">Retrieve &#43; Remember</phrase></box-title></box-metadata>" . $content;
	}


	$content =~ s`block_type="sr-que-bl">`block_type="sr-que-bl"><phrase block_type="blue_bullet">&#8226;</phrase>`g;

    # yes, we are returning "boxer"
    return qq`<boxer ${args}>${content}</boxer>`;
}


sub process_para {
    my $args = shift; #attributes on <p> tag
    my $content = shift; # contents of para
	
	$args =~ s`app\d+-lo-que`lo-que`;
	
	my ($p_type) = $args =~ /block_type="([^"]+)"/;
	my ($p_id) = $args =~ /id="([^"]+)"/;
	
	if ($p_type eq "fn") {
		print STDERR "PROCESS FOOTNOTE! ID: $p_id\n";
	}
	
	if ($p_type eq "co-toc-h2" || $p_type eq "co-toc-bx1-t" || $p_type eq "bm-app-toc-i2" || $p_type eq "appendix_number") {
		$content =~ s`<link href="pel4e[^>]+>(.*?)</link>`\1`;
	}

	if ($p_type eq "lo-que") {
		return qq`<box numbered="false" id="lo-que-box_${p_id}" block_type="lo-que-box"><p ${args}>$content</p></box>`;
	}
	
	if ($content =~ m/(<link href="pel4e-ch\d+.xml#pel4e-ch\d+-sec1-(\d+)">)/) {
		my $PLUSONE = $2 + 1;
		$content =~ s`<link href="pel4e-ch\d+.xml#pel4e-ch\d+-sec\d+-(\d+)">`<link href="pel4e_ch${CHAPTER}_${PLUSONE}.html" target="_pop">`g;
	}
	if ($content =~ m/(<link href="pel4e-app[a-z]+.xml#pel4e-app\d+-sec1-(\d+)">)/) {
		my $PLUSONE = $2 + 1;
		$content =~ s`<link href="pel4e-app[a-z]+.xml#pel4e-(app\d+)-sec\d+-(\d+)">`<link href="pel4e_\1_${PLUSONE}.html" target="_pop">`g;
	}

	$content =~ s`<phrase block_type="blue_bullet">&#8226;</phrase>ANSWER`ANSWER`;

	if ($content =~ m/^ANSWER(S)?:/) {
		$args = "id=\"${p_id}\" block_type=\"answer\" data-show-answer=\"this\"";
		
	}

    return qq`<p ${args}>$content</p>`;
}


# This function will automatically create subdirectories to store the supp
# html files it produces as follows:

# figures: img_chN/ (where 'N' is the chapter number specified in the xml)
# tables: table/

sub create_supp_file {
    my $type = shift; # 'figure' or 'table'
    my $filename = shift; # the name of the supp file we are creating
    my $args = shift; # the attributes of the tag
    my $content = shift; # the content in the tag

    if ($filename eq "" || $filename =~ /\s/) {
	print STDERR "Bad filename for supp file [args: $args]\n";
	return;
    }

    # determine write file
    my $write_file;

    if ($type eq "figure") {
	# if only the filename is passed then add the default sub directory
	if ($filename !~ /\//) {
	    my $sub_dir = "img_ch${CHAPTER}";
	    if (!-d $sub_dir) {
		mkdir($sub_dir);
	    }
	    $write_file = $sub_dir . "/" . $filename;
	    $write_file =~ s`\.([a-z]+)$`.html`;
	    if ($write_file !~ /\.html$/) {
		$write_file .= ".html";
	    }
	}
	# otherwise use the filename passed in
	else {
	    $write_file = $filename;
	}
    }
    elsif ($type eq "table") {
	if ($filename !~ /\//) {
	    my $sub_dir = "../table";
	    if (!-d $sub_dir) {
		mkdir($sub_dir);
	    }
	    $write_file = $sub_dir . "/" . $filename;
	    $write_file =~ s`\.([a-z]+)$`.html`;
	    if ($write_file !~ /\.html$/) {
		$write_file .= ".html";
	    }
	}
	else {
	    $write_file = $filename;
	}
    }
    else {
	print STDERR "Bad type ($type) passed to create_supp_file\n";
	return;
    }

    $content =~ s`<link (href="[^"]+")>(.*?)</link>`<span data-type="link" data-$1>$2</span>`g;

    if (!open(OUT, ">${write_file}")) {
	print STDERR "create_supp_file: Can't write to ${write_file}: $!\n";
	return;
    }

    binmode(OUT, ":utf8");

    my $supp_content;

    if ($type eq "figure") {

	my ($block_type) = $args =~ /block_type="([^"]+)"/;
	my ($id) = $args =~ /id="([^"]+)"/;

	$content =~ s`<figure [^>]+>`<div data-type="figure">\n`;
	$content =~ s`<phrase block_type="head">(.*?)</phrase>`<span data-block_type="head">\1</span>`;
	$content =~ s`<asset_source>(.*?)</asset_source>`<div data-type="asset_source">\1</div>\n`g;

	# We assume there is only one <caption> per <figure>
	$content =~ s`<caption>(.*?)</caption>`<div data-type="figure_text"><span data-type="caption">\1</span></div>\n`g;

	$content =~ s`</figure>`</div>\n`;
	$content =~ s`<layout [^>]+>``;

	$content =~ s`src="(?:[^"]+\/)?(.*\.(?:jpg|gif|png|tiff))"`src="$1"`;

	$content =~ s`<image `<img `;

	$supp_content = qq`<div data-type="figure" data-figure-id="${id}" data-block_type="${block_type}">${content}</div>`;

    }
    elsif ($type eq "table") {

	my ($block_type) = $args =~ /block_type="([^"]+)"/;
	my ($id) = $args =~ /id="([^"]+)"/;
	my ($layout) = $content =~ /<layout(?:[^>]+)?align="([^"]+)"(?:[^>]+)?\/>/;
	my ($width) = $content =~ /<layout(?:[^>]+)?width="([^"]+)"(?:[^>]+)?\/>/;
	my ($border) = $content =~ /<layout(?:[^>]+)?border="([^"]+)"(?:[^>]+)?\/>/;
	my ($number) = $args =~ /number="([^"]+)"/;

	$content =~ s`<layout[^>]+>``;
	
	$content =~ s`<list((?:(?!type).)*?)type="unordered"([^>]+)?>((?:(?!</list>).)*?)</list>`<ul $1$2>$3</ul>`g;
	$content =~ s`<list((?:(?!type).)*?)type="ordered" block_type="numbered">((?:(?!</list>).)*?)</list>`<ol $1>$2</ol>`g;

	$content =~ s`<table_caption>(.*?)</table_caption>`<div data-type="table_text"><span data-type="number">Table ${number}: </span><span data-type="table_caption">$1</span></div>`;

	$supp_content = qq`<div data-type="table" data-block_type="${block_type}" id="${id}" data-layout-align="${layout}" data-layout-width="${width}" data-layout-border="${border}" data-mmsrc="" data-attr=""><table width="auto" height="auto">${content}</table></div>`;
    }

    $supp_content =~ s`<phrase block_type="([^"]+)">`<span data-block_type="\1">`g;
    $supp_content =~ s`</phrase>`</span>`g;

    my $pub_ext = "";
    if ($PUBLISHER eq "fw" || $PUBLISHER eq "FW") {
	$pub_ext = "_fw";
    }

    $supp_content = fix_linebreaks($supp_content);

    print OUT<<ENDL;
<!DOCTYPE html>
<!--[if lt IE 7 ]> <html lang="en" class="no-js ie6"> <![endif]-->
<!--[if IE 7 ]>    <html lang="en" class="no-js ie7"> <![endif]-->
<!--[if IE 8 ]>    <html lang="en" class="no-js ie8"> <![endif]-->
<!--[if IE 9 ]>    <html lang="en" class="no-js ie9"> <![endif]-->
<!--[if (gt IE 9)|!(IE)]><!--> <html lang="en" class="no-js"> <!--<![endif]-->
<head>
    <title></title>
    <meta charset="utf-8">
    <meta http-equiv="X-UA-Compatible" content="IE=edge,chrome=1">
    <meta name="viewport" content="width=device-width, initial-scale=1.0">


<link href="../../css/boilerplate.css" media="screen" rel="stylesheet" type="text/css" >
<link href="../../css/jquery-ui-custom.css" media="screen" rel="stylesheet" type="text/css" >
<link href="../../css/manuscript.css" media="screen" rel="stylesheet" type="text/css" >
<link href="../../css/digfir_ebook${pub_ext}.css" media="screen" rel="stylesheet" type="text/css" >
<link href="../../css/${BOOK_ID}.css" media="screen" rel="stylesheet" type="text/css" >
<link href="../../css/${BOOK_ID}_ch${CHAPTER}.css" media="screen" rel="stylesheet" type="text/css" >
</head>

<body id="supp_win">
<div id="manuscript" data-chapter-number="${CHAPTER}">
<div data-type="section">

${supp_content}

</div>
</div><!-- /#manuscript -->
<br class="clear" />
<!-- end of material in original view -->

<script type="text/javascript" src="../../js/utilities.js"></script>
<script type="text/javascript" src="../../js/query_types.js"></script>
<script type="text/javascript" src="../../js/player.js"></script>
<script type="text/javascript" src="../../js/jquery.js"></script>
<script type="text/javascript" src="../../js/jquery-ui-1.8.16.custom.min.js"></script>
<script type="text/javascript" src="../../js/jquery_extensions.js"></script>
<script type="text/javascript" src="../../js/swfobject.js"></script>
<script type="text/javascript" src="http://admin.brightcove.com/js/BrightcoveExperiences.js"></script>
<script type="text/javascript" src="../../js/digfir_ebook${pub_ext}.js"></script>
<script type="text/javascript" src="../../js/${BOOK_ID}.js"></script>
<script type="text/javascript">
    //<!--

\$(window).ready(function () {
	player.initialize('52c6e83c757a2ef70c000000');
});
    //-->
</script>

</body>
</html>
ENDL


close(OUT);
} # end create_figure_supp_file


# Adds <phrase block_type="nobr"> around (em/en)dash and letter preceding it.
# Adds <wbr> after (em/en)dash.  This forces all browswers to line break after
# the dash.
# While we are at it, add <wbr> after forward slash in URLs.
# This does not fix anything inside <rawhtml>.
sub fix_linebreaks {
    my $text = shift;
    my $new_text = "";
    my @tokens = split(/(<[^>]+>)/,$text);

    my $token;
    my $protected = 0;
    foreach $token (@tokens) {

	# look for tags first
	if ($token =~ /<(rawhtml|link)/) {
	    $protected = $1;
	}
	elsif ($token =~ /<\/${protected}/) {
	    $protected = 0;
	}
	elsif ($token =~ /</) {
            # nothing to do here, this is just a tag
	}
	# if we've made it this far we have text
	elsif (!$protected) {
	    # the last char in the pattern is a utf emdash
	    $token =~ s`([a-zA-Z0-9](&#8211;|&#8212;|-|—))`<phrase block_type="nobr">$1</phrase><wbr/>`g;
	}
	elsif ($protected eq "link") {
	    $token =~ s`([^/]/)`${1}<wbr/>`g;
	}
	$new_text .= $token;
    }

    return $new_text;
}


__END__

(NOTE: Do not put any perl code below.  All perl code should go above __END__)

CHANGE LOG

2014-02-04: Script now creates supplemental html files for images and numbered tables.
 - added $PUBLISHER variable (must be set to either "bsm" or "fw")
 - added create_supp_file()
 - added calls to create_supp_file() in process_figure() and process_table()

2014-02-14: Fixed bug found by Kevin in process_figure where pattern
for finding $img_file_no_text was too greedy (added '?')

2014-06-02: Added fix_linebreaks() to force browsers to break line correctly
at (em/en)dash

2014-06-02: Added check for inline tags in section titles

2014-06-24: Fixed bug in post_process_section: moved $args =~ s`title="[^"]+"`title=""`; inside of if block

2014-08-15: Added call to fix_linebreaks() in create_supp_file()

2015-12-01: Added code to check for page numbers 
