SHARE
TWEET

cueScripGen.pl

tambascot Jan 16th, 2013 48 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #!/usr/bin/perl
  2. #
  3. # cueScriptGen
  4. #
  5. # Generate a cue script from an MIT Shakespeare File
  6. #
  7. # By Tony Tambasco
  8. #
  9. # Released under the GPL 2.0 and all that jazz.
  10. #
  11. # This is just a prototype. A more polished version will need further
  12. # testing and development.
  13. #
  14. # Last Revised 15 Jan. 2013 11 PM
  15.  
  16. use strict;
  17. use warnings;
  18.  
  19. # The user must give us at least one character name (but may give us
  20. # any number of them), followed by a script file. If they don't,
  21. # print a simple error and exit.
  22.  
  23. if (@ARGV < 2) {
  24.   die "usage is \"cueScriptGen character_1 [character_2 &c] file_name\"\n";
  25. }
  26.  
  27. # We should edit this to either accept a file name or a URL.
  28. # If we force a URL, we can explore transformations based on
  29. # alternative methods of formatting.
  30.  
  31. # Whatever the file is, it will be the LAST thing in our
  32. # argument list, so pop it off so we have a list of nothing
  33. # but characters.
  34. my $mit_shakes = pop @ARGV;
  35.  
  36. # Initialize variables.
  37. my $cue_line      = "";
  38. my $prev_cue_line = "";
  39. my $act           = "";
  40. my $scene         = "";
  41. my $new_act       = undef;
  42. my $new_scene     = undef;
  43. my $line          = "";
  44. my $title_of_play = "";
  45.  
  46. # Open a file or quit with a basic warning if you can't.
  47. open PLAY, $mit_shakes or die "Could not open file: $!\n";
  48.  
  49.  
  50.   # Step 0.5: Print basic html header info from the file, and
  51.   # them some heading info so the reader knows what they're
  52.   # looking at.
  53.  
  54. until ($line =~ m/<\/head>/) {
  55.   if ($line =~ m/<title>(.*)<\/title>/) {
  56.     $title_of_play = $1;
  57.   }
  58.   print "$line";
  59.   $line = <PLAY>;
  60. }
  61.  
  62. print "</head>\n<body>\n";
  63. print "<h1>$title_of_play</h1>\n";
  64. print '<h2>Cue Script for ';
  65.  
  66. # This boolean will tell us if we're on the
  67. # first item in the list, which should not
  68. # be preceeded by a comma and a space when
  69. # printing the list of characters.
  70.  
  71. my $i = 0;
  72.  
  73. foreach (@ARGV) {
  74.   if ($i == 0) {
  75.     print "$_";
  76.     $i = 1;
  77.   }
  78.  
  79.   else {
  80.     print ", $_";
  81.   }
  82. }
  83.  
  84. print ". </h2>\n";
  85.  
  86.  
  87. # Traverse the file until EOF
  88. while ($line = <PLAY>) {
  89.   # The editor may have edited by commenting out text. In this case, we should
  90.   # presume they have use comment delimiters exactly as if they had deleted all
  91.   # text and markup in between them. i.e. comment delimiters may be used to join
  92.   # multiple speeches by multiple characters into a single speech.
  93.  
  94.   if ($line =~ m/.*<!--.*/) {
  95.  
  96.     # Split the line with the comment mark, everything before it is
  97.     # text we want to print. Everything after we can ignore...
  98.    
  99.     my ($keep, $comment) = split /<!--/, $line;
  100.     print "$keep\n";
  101.     $cue_line = $keep;
  102.  
  103.     # Until we find a closing comment mark...
  104.    
  105.     $line = <PLAY> until ($line =~ m/.*-->.*/);
  106.  
  107.     # When we split the line again, this time keep everything
  108.     # to the right of the mark, and discarding the rest.
  109.    
  110.     ($comment, $keep) = split /-->/, $line;
  111.     print "$keep\n";
  112.     $prev_cue_line = $cue_line;
  113.     $cue_line = $keep;  
  114.    
  115.   }
  116.  
  117.   # Step 1: Find a speech block that contains a character that we're looking for.
  118.   # We need to do this for every character left in our arguument list.
  119.   foreach (@ARGV) {
  120.     my $character = $_;
  121.    
  122.     if ($line =~ m/^<a name="speech\d+"><b>$character<\/b>/i) {
  123.  
  124.       # Print the act heading if we haven't yet.
  125.       if ($new_act) {
  126.         print "$act\n";
  127.         $new_act = undef;
  128.       }
  129.  
  130.       # Print the scene headin if we haven't yet.
  131.       if ($new_scene) {
  132.         print "$scene\n";
  133.         $new_scene = undef;
  134.       }
  135.      
  136.       # Step 2: We've found a line of text that matches a block of text for the
  137.       # character we're looking for, so first we need to print their cue line.
  138.       # See step 1.5 (below) for details. If the cue line is less than three
  139.       # words long, print the line that came before it, too.
  140.  
  141.       $cue_line =~ m/^<a name="\d+\.\d+\.\d+">(.*)</;
  142.      
  143.       my @cue_words = split /\s/, $1;
  144.       my $cue_words = @cue_words;
  145.      
  146.       if ($cue_words < 2) {
  147.         print "<b>Cue:</b> $prev_cue_line\n$cue_line\n\n";
  148.       }
  149.      
  150.       else {
  151.         print "<b>Cue:</b> $cue_line\n\n";
  152.       }
  153.      
  154.       # Step 3: Print the entire speech block for the character; you know you're
  155.       # at the end of the block when you reach the closing blockquote
  156.       while ($line !~ m/<\/blockquote>/) {
  157.  
  158.         print "$line\n";
  159.  
  160.         # We still need to keep track of the cue line, just in case the cue script
  161.         # is for an actor who plays two roles with back to back lines.
  162.         $prev_cue_line = $cue_line;
  163.         $cue_line      = $line;
  164.        
  165.         # Read the next line of the file.
  166.         $line = <PLAY>;
  167.       }
  168.  
  169.       # Step 4: Print the closing blockquote.
  170.       print "</blockquote>\n";
  171.      
  172.     }
  173.    
  174.     # Step 1.5: We need to keep track of each line of text as we go, so if the
  175.     # line was not a speech heading, see if it's a line of text. If it is, keep it  
  176.     elsif ($line =~ m/^<a name="\d\.\d+\.\d+"/) {
  177.       $prev_cue_line = $cue_line;
  178.       $cue_line      = $line;
  179.     }
  180.  
  181.     # Step 1.6: We should also print act headings.
  182.     elsif ($line =~ m/.*<h3>ACT \w+.*/) {
  183.       $act       = $line;
  184.       $new_act   = "true";
  185.     }
  186.  
  187.     # Step 1.7: We should also print scene headings.
  188.     elsif ($line =~ m/.*<h3>SCENE \w+.*/) {
  189.       $scene     = $line;
  190.       $new_scene = "true";
  191.     }
  192.  
  193.     # Step 1.8: If a line begins with a comment delimiter, skip ahead to the
  194.     # end of the commnt block.
  195.    
  196.   }
  197. }
  198.    
  199. # Last piece of cleanup, close off our HTML elements
  200.  
  201. print "\n</body>\n</html>\n";
RAW Paste Data
Top