#!/usr/princeton/bin/perl -w
 
########################################################################
#
#    punstar.pl
#
# Application for creating pure HTML files by removing
# Mappamundi markup (*x, *g, *s, etc) from a file.
# Extracts text between *x marks into separate, hotlinked files.
#
# Copyright (c) Princeton University 1995
#
# Jay Lieske, Jr.
# Instructional Technology Services
# Computer and Information Technology
# Princeton University
#
#
 
#$usage = << END_USAGE;
#punstar removes Mappamundi markup codes (*g, *x, etc.) from
#     its input file.    Jay Lieske, 95.07.14
#usage: punstar filename.html
#produces: filename-1.html -- the recoded file
#          other html files named in *x markup
#END_USAGE
 
#require "cgi-lib-jay.pl"; # for EncodeURL()
 
#!/usr/princeton/bin/perl -w
#
# cgi-lib-jay.pl
# Jay Lieske Jr.
# 4 August 1994
 
 
# EncodeURL
# Returns copy of input string encoded for URLs (spaces to plus, etc.)
sub EncodeURL {
     local( $_) = @_;
     
     s|\%|%25|g;
     s|\!|%21|g;
     s|\"|%22|g;
     s|\#|%23|g;
     s|\$|%24|g;
     s|\&|%26|g;
     s|\'|%27|g;
     s|\*|%2A|g;
     s|\+|%2B|g;
     s|\/|%2F|g;
     s|\?|%3F|g;
     s|\@|%40|g;
     s|[\000-\037][\200-\377]|'%'.sprintf("%2X", $1)|ge;
     s| |+|g;
     
     $_;
}
 
# End of cgi-lib-jay.pl
 
 
#require "FormatStar.pl";
#!/usr/princeton/bin/perl -w
 
########################################################################
#
#    FormatStar.pl
#
# Functions for creating pure HTML files by removing
# Mappamundi markup (*x, *g, *s, etc) from a file.
#
# Copyright (c) Princeton University 1995
#
# Jay Lieske, Jr.
# Instructional Technology Services
# Computer and Information Technology
# Princeton University
#
#
# Usage:
#    at top of program,
# require "FormatStar.pl"
#
#    to reformat a string of HTML by embedding hotlinks,
# $linkedtext = &LinkStar( $text);
#
#    to reformat a string of HTML without hotlinks,
# $plaintext = &StripStar( $text);
#
 
#require "cgi-lib-jay.pl"; # for EncodeURL()
 
# Global variables used in module:
if (0) {
     $ImageGIF;
     $ImageJPEG;
     $Table;
     $Debug;
     $ScriptSlide;
     $ScriptGloss;
     
     &FormatStar;
     &LinkStar;
     &StripStar;
}
 
 
########################################################################
#    MakeLinkHTML
#
# Generate HTML code for text hotlink to something.
#
# usage: print &MakeLinkHTML( $url, $caption);
#
# Globals: none
#
sub MakeLinkHTML {
     local ($url, $caption) = @_;
     local ($html) = "";
     
     if ($url !~ /^\s*$/) {
          
          $html = "<A HREF=\"$url\">$caption</A>";
     }
     $html; # return value
}
 
########################################################################
#    MakeImageHTML
#
# Generate HTML code for thumbnail image hotlinked to hi-res image.
#
# usage: print &MakeImageHTML( $cd, $caption);
#
# Globals: $ImageGIF -- URL to directory where thumbnail images are kept.
#          $ImageJPEG -- URL to directory where hi-res images are kept.
#
sub MakeImageHTML {
     local ($cd, $caption) = @_;
     local ($html) = "";
     
     $caption = "Image" if !defined($caption);
     
     # If $cd is not blank, create an inline and linked image string.
     if ($cd !~ /^\s*$/) {
               # Chop off leading zeros.
          $cd =~ s/^0+([1-9])/\1/;
          $cd =~ s/\-0+([1-9])/\-\1/;
          
          $html = "<A HREF=\"$ImageJPEG/$cd.jpeg\">"
                 . "<IMG SRC=\"$ImageGIF/$cd.gif\" ALIGN=\"MIDDLE\"
ALT=\"[$caption]\"></A>";
     }
     $html; # return value
}
 
########################################################################
#    MakeAudioHTML
#
# Generate HTML code for hotlink to audio.
#
# usage: print &MakeAudioHTML( $sound, $caption);
#
# Globals: none
#
sub MakeAudioHTML {
     local ($sound, $caption) = @_;
     local ($html) = "";
     
     if ($sound !~ /^\s*$/) {
          
          $html = "<A HREF=\"$sound\">$caption</A>";
     }
     $html; # return value
}
 
########################################################################
#    MakeTextHTML
#
# Generate HTML code for hotlink to external text.
#
# usage: print &MakeTextHTML( $text, $caption);
#
# Globals: none
#
sub MakeTextHTML {
     local ($text, $caption) = @_;
     local ($html) = "";
     
     if ($text !~ /^\s*$/) {
          
          $html = "<A HREF=\"$text\">$caption</A>";
     }
     $html; # return value
}
 
########################################################################
#    MakeSlideHTML
#
# Generate HTML code for text hotlink which refers to slide sheet in
# database.
#
# usage: print &MakeSlideHTML( $slide, $text);
#
# Globals: $ScriptSlide -- URL to CGI to display slide page.
#          $Table -- the Oracle table from which the slide will be read.
#          $Debug -- either "/debug" or "".
#
sub MakeSlideHTML {
     local ($id, $text) = @_;
     local ($html) = "";
     
     $id =~ s/\s//g;
     $id =  &EncodeURL( $id);
 
     # A fix in case we are searching the glossary table --bpd
     local($table) = $Table;       
     $table="mappa" if ($table eq "gloss");
 
     $html = "<A HREF=\"$ScriptSlide$Debug/$table?mslide=$id\">$text</A>";
 
     $html; # return value
}
 
########################################################################
#    MakeGlossHTML
#
# Generate HTML code for text hotlink which refers to glossary page in
# database.
#
# usage: print &MakeGlossHTML( $term, $text);
#
# Globals: $ScriptGloss -- URL to CGI to display glossary page.
#          $Debug -- either "/debug" or "".
#
sub MakeGlossHTML {
     local ($term, $text) = @_;
     local ($html) = "";
     
     $term = &EncodeURL( $term);
     $html = "<A HREF=\"$ScriptGloss$Debug?$term\">$text</A>";
 
     $html; # return value
}
 
########################################################################
#    FormatStar
#
# Main subroutine to look for star tags in $text and replace them with
# valid HTML.  Output code will be hotlinked if $linking is true.
#
# usage: print &FormatStar( $text, $linking);
#
# Globals: none
#
sub FormatStar {
     local ($text, $linking) = @_;
     local ($out) = "";
     local ($this, $display, $search, $star);
     local (@stars) = ("g",  # glossary word
                       "s",  # slide in database
                       "l",  # URL
                       "m",  # map
                       "a",  # music/audio
                       "t"); # link to external text
                     # "x": text to make external not processed here
     local ($stars) = join( "", @stars);
     
     # Repeated look over the string, matching each star tag in turn.
     # Tags can not be nested.
     #
     MATCH:
     while ($text ne "") {
               # Any stars in the text?
          if ($text =~ m/\*([$stars])/io) {
                    # Copy string before *g.
               $out .= $`;
                    # Which tag did we find?
               #$star = $&;
               $star = $1;
                    # Advance to after *g.
               $text = $';
                    # Advance to after closing *,
                    # saving the intervening text.
               $text =~ s/^([^*]*)\*//;
               $this = $1;
               
               # Chop off leading/trailing spaces.
               $this =~ s/^\s+//;
               $this =~ s/\s+$//;
               
               # If the text has alternate database and display version, get them.
               ($search, $display) = split( m!/!, $this, 2);
               $display = $search if (!defined($display) || $display =~ /^\s*$/);
               
                    # Glossary word:
               $star eq "g" && do {
                    $out .= $linking ? &MakeGlossHTML( $search, $display)
                                     : $display;
                    next MATCH;
               };
               
                    # Slide in database:
               $star eq "s" && do {
                    $out .= $linking ? &MakeSlideHTML( $search, $display)
                                     : $display;
                    next MATCH;
               };
               
                    # Map or image:
               $star eq "m" && do {
                    $out .= $linking ? &MakeImageHTML( $search, $display)
                                     : $display;
                    next MATCH;
               };
 
                    # URL hotlink:
               $star eq "m" && do {
                    $out .= $linking ? &MakeLinkHTML( $search, $display)
                                     : $display;
                    next MATCH;
               };
 
                    # Music/audio:
               $star eq "a" && do {
                    $out .= $linking ? &MakeAudioHTML( $search, $display)
                                     : $display;
                    next MATCH;
               };
 
                    # Text:
               $star eq "t" && do {
                    $out .= $linking ? &MakeTextHTML( $search, $display)
                                     : $display;
                    next MATCH;
               };
          }
          else {
                    # No star: just append text.
               $out .= $text;
               last MATCH;
          }
     };
     
     $out;# return value
}
 
########################################################################
# usage: print &StripStar( $text);
sub StripStar {
     return &FormatStar( $_[0], 0);
}
 
########################################################################
# usage: print &LinkStar( $text);
sub LinkStar {
     return &FormatStar( $_[0], 1);
}
 
1; # successful require
# end of FormatStar.pl
 
 
#require "ExtractStar.pl";
#!/usr/princeton/bin/perl -w
 
########################################################################
#
#    ExtractStar.pl
#
# Functions for creating pure HTML files by removing
# Mappamundi markup (*x, *g, *s, etc) from a file.
# Extracts text between *x marks into separate, hotlinked files.
#
# Copyright (c) Princeton University 1995
#
# Jay Lieske, Jr.
# Instructional Technology Services
# Computer and Information Technology
# Princeton University
#
#
# Usage:
#    at top of program,
# require "ExtractStar.pl"
#
#    to copy HTML from STDIN to STDOUT,
# &ExtractStar( STDIN, STDOUT, "Title");
#
 
# Global variables used in module:
if (0) {
     &ExtractStar;
}
 
#require "FormatStar.pl";
 
 
########################################################################
#    MakeHeadHTML
#
# Generate HTML code for <HEAD> of document.
#
# usage: print &MakeHeadHTML( $filename, $title);
#
# Globals: none
#
sub MakeHeadHTML {
     local ($filename, $title) = @_;
     local ($html);
     
          # Remove spaces.
     $filename =~ s/^\s+//; $filename =~ s/\s+$//;
     
     $title = $filename if !defined( $title);
     
     $html = <<ENDHEAD;
<HTML><!-- $filename: Generated by ExtractStar -->
<HEAD><TITLE>
$title
</TITLE></HEAD>
<BODY>
ENDHEAD
 
     $html; # return value
}
 
########################################################################
#    MakeNeckHTML
#
# Generate HTML code top of <BODY>.
#
# usage: print &MakeNeckHTML( $filename, $title);
#
# Globals: none
#
sub MakeNeckHTML {
     local ($filename, $title) = @_;
     local ($html);
     
     $title = $filename if !defined( $title);
     
     $html = <<ENDNECK;
<H1>
$title
</H1>
ENDNECK
 
     $html; # return value
}
 
########################################################################
#    MakeBackHTML
#
# Generate HTML code to link to parent document.
#
# usage: print &MakeBackHTML( $filename, $title);
#
# Globals: none
#
sub MakeBackHTML {
     local ($filename, $title) = @_;
     local ($html);
     
     $title = $filename if (!defined( $title) || $title =~ /^\s*$/);
     
     $html = <<ENDBACK;
Back to
<A HREF="$filename">$title</A>
ENDBACK
 
     $html; # return value
}
 
########################################################################
#    MakeTailHTML
#
# Generate HTML code for end of <BODY>.
#
# usage: print &MakeNeckHTML( $filename, $title);
#
# Globals: none
#
sub MakeTailHTML {
     local ($filename, $title) = @_;
     local ($html);
     
     $title = $filename if !defined( $title);
     
     $html = <<ENDTAIL;
</BODY></HTML>
ENDTAIL
 
     $html; # return value
}
 
########################################################################
#    MakeExtractHTML
#
# Generate HTML code for hotlink to extracted file.
#
# usage: print &MakeExtractHTML( $file, $caption);
#
# Globals: none
#
sub MakeExtractHTML {
     local ($file, $caption) = @_;
     local ($html) = "";
     
     if ($text !~ /^\s*$/) {
          
          $html = "<P><A HREF=\"$file\">$caption</A><P>";
     }
     $html; # return value
}
 
########################################################################
#    ExtractStar
#
# Main subroutine to look for *x tags in $text, extract the surrounded
# text to a separate file, and insert links to the extracted text file.
# Extracted text blocks can be nested, and this function calls itself
# recursively.
#
# The parameters are file names which are also file handles.
# The calling subroutine should create the basic HTML structuring
# of <HTML><HEAD>...</HEAD><BODY> before calling
# and </BODY></HTML> after calling.
#
# usage: &ExtractStar( $infile, $outfile);
#
# Globals: none
#
sub ExtractStar {
     local ($infile, $outfile, $title) = @_;
     local ($/);# input line separator
     local ($text);
     
     
     for (;;) {
          # Scan for *x tag.
          $/ = "*x";
          $text = <$infile>;
               # Look for a <title> tag.
          if ($title eq "" || $title eq $infile) {
               if ($text =~ m!<title>\s*([^<]+)\s*</title>!i) {
                    $title = $1;
               }
          }
          if ($text !~ s/\*x$//i) {
                    # No text to extract, so print what we have and we're done.
               print $outfile &LinkStar( $text);
               last;
          }
          
               # We found some text to extract.  First, print what we have.
          print $outfile &LinkStar( $text);
               # Scan for closing * mark.
          $/ = "*";
          $text = <$infile>;
               # Make sure we got that closing *.
          if ($text !~ s/\*$//i) {
               warn "ExtractStar: found a *x without a closing *!\n";
               last;
          }
          
               # See whether this is a *x* to end extraction.
          if ($text =~ /^\s*$/) {
                    # Done extracting.  Return to caller, which will close the file.
               last;
          }
               # Get the file name and title.
          ($newname, $newtitle) = split( m!/!, $text, 2);
          $newtitle = $newname if ($newtitle =~ /^\s*$/);
          
               # Create new extract file.
          if (!open( $newname, ">$newname")) {
               warn "ExtractStar: could not create file $newname: $!\n";
                    # Continue extracting into same file.
               &MakeNeckHTML( $outfile, $newtitle);
               $newname = $outfile;
               $newtitle = "";
          }
          else {
                    # Put link to new file in current file.
               print $outfile &MakeExtractHTML( $newname, $newtitle);
                    # Start HTML file.
               print $newname &MakeHeadHTML( $newname, $newtitle);
               # print $newname &MakeBackHTML( $outfile, $title), "\n<HR>\n";
               print $newname &MakeNeckHTML( $newname, $newtitle);
          }
          
               # Recursively extract into new file.
          &ExtractStar( $infile, $newname, $newtitle);
          
               # Close new file.
          if ($newname ne $outfile) {
               print $newname "\n<HR>\n", &MakeBackHTML( $outfile, $title);
               print $newname &MakeTailHTML( $newname, $newtitle);
               close( $newname);
          }
          
               # Continue copy to next *x ...
     }
     
}
 
1;   # successful require
# end of ExtractStar.pl
 
 
# What platform are we on?
$mac = defined($MacPerl'Version);
 
local ($infile);# name of input file, or '-' for stdin
local ($outfile);# name of recoded output file, or '-' for stdout
 
$infile = shift( @ARGV);
 
# Did we get a filename on the command line?
if (!defined($infile)) {
     # If we are running MacPerl, show a Standard File dialog.
     if ($mac) {
          require "StandardFile.pl";
          $infile =
               &StandardFile'GetFile( "Select the file to unstar", 'TEXT');
          die $usage if (!defined($infile) || $infile eq "");
     }
     # If we are running under Unix, we *won't* assume a null filename 
     #  means stdin...
     else {
          die $usage;
     }
}
 
# Determine the file path from $infile.
local ($path);# file path for new files; base on infile
local ($base);# remove the .html (if any) from the end of the filename
if ($mac) {
          # Extract text before last colon.
     ($path, $base) = ($infile =~ m!(.*:)([^:]*)$!);
}
else { # not Mac
          # Extract text before last slash.
     ($path, $base) = ($infile =~ m!(.*/)([^/]*)$!);
}
$path = "" if !defined( $path);
$base = $infile if !defined( $base);
$base =~ s/.html$//i;
 
# Switch to the output file's directory so the *x files sit there too.
if ($path ne "") {
     chdir $path || die "Can't chdir to $path: $!\n";
     $infile =~ s/^$path//;
}
 
# Are we using stdin/stdout?
if ($infile eq "-") {
     $outfile = "-";
}
# Otherwise name the output file.
else {
     $outfile = "$base-1.html";
}
 
# Name the URLs used by *g, etc.
     $ImageGIF = "";
     $ImageJPEG = "";
     $Table = "mappa";
     $Debug = "";
     $ScriptBase = "http://www.princeton.edu/cgi-bin/Mappamundi";
     $ScriptSlide = "$ScriptBase/mappamundi-slide/";
     $ScriptGloss = "$ScriptBase/mappamundi-gloss/gloss";
# Global variables from FormatStar.pl:
if (0) {
     $ImageGIF;
     $ImageJPEG;
     $Table;
     $Debug;
     $ScriptSlide;
     $ScriptGloss;
     
     &FormatStar;
     &LinkStar;
     &StripStar;
}
 
 
open( $infile, "<$infile") || die "$infile: can't open, $!\n";
 
open( $outfile, ">$outfile") || die "$outfile: can't create, $!\n";
if ($mac) {
          # Make it a Netscape file.
     &MacPerl'SetFileInfo( "MOSS", "TEXT", $outfile);
}
 
# Copy the file.
 
&ExtractStar( $infile, $outfile, "");
 
if (!eof( $infile)) {
     warn "$infile: An ending *x* did not have a starting *x name/title*!\n";
}
close( $outfile);
close( $infile);
exit( 0);