tw-assembly

#!/usr/bin/perl

###########################################################
# by Jan Rychlý (github: honzaflash)                     
# 
# Simple script for assembling and disassembling
# a Twine HTML document
# 
# examples:
#   tw-assembly storywithlinkedcss.html -a
#   tw-assembly bits.html bitsassembled
#   tw-assembly bits.html bitsassembled.html
#   tw-assembly mystory.html -d
###########################################################

# TODO refactor - divide the main body of the script into proper subroutines

use strict;
use warnings;
use utf8;

use File::Basename;
use File::Copy;

# static globals
my $usage =
    "usage: tw-assembly [-h][-s][-f][-o][-a][-d][-js JS_FILE] HTML_FILE [OUTPUT_NAME]\n" .
    # "       tw-assembly [-h][-s][-f][-o] -d HTML_FILE [OUTPU_NAME]\n" .
    "";


# options
my $assembling;
my $overwrite_dis;
my $javascript;
my @files;
my $safe_open = 1;
my $html_in_pth;
my $output_name;
my $output_base_path;
# my $verbose;

# global dict of opened files
my %paths;

# global list of linked css files
my @css_in_pths;


parse_args(@ARGV);

if ($javascript && !defined $assembling) {
    # TODO  make this a separate subrutine
    # and make it work separately *or together with assembly mode* 

    print "input html needed\n" if (!defined $html_in_pth);
    open(HTML_IN, '<', $html_in_pth) or die "couldn't open the html: $html_in_pth";
    open(JS_IN, '<', $javascript) or die "couldn't open javascript: $javascript";

    open_new(\*HTML_OUT, "$output_base_path$output_name", '.html');

    my $state = 0;
    while (<HTML_IN>) {
        if ($_ =~ /(.*)<script role="script" id="twine-user-script" type="text\/twine-javascript">(.*)<\/script>(.*)/) {
            # opening and closing tag at the same line
            my $pre_script = $1 ? "$1\n" : "";
            print HTML_OUT "$pre_script<script role=\"script\" id=\"twine-user-script\" type=\"text/twine-javascript\">\n";
            read_and_paste(\*JS_IN, \*HTML_OUT);
            print HTML_OUT "\n</script>$3";

        } elsif ($_ =~ /(.*)<script role="script" id="twine-user-script" type="text\/twine-javascript">(.*)/) {
            # found only opening tag
            my $pre_script = $1 ? "$1\n" : "";
            print HTML_OUT "$pre_script<script role=\"script\" id=\"twine-user-script\" type=\"text/twine-javascript\">\n";
            read_and_paste(\*JS_IN, \*HTML_OUT);
            close(JS_IN);
            $state = 1;

        } elsif ($state == 1 && $_ =~ /(.*)<\/script>(.*)/) {
            # found the closing tag
            print HTML_OUT "\n</script>$2\n";
            $state = 42;

        } elsif ($state == 1) {
            # ignoring the existing javascript

        } else {
            print HTML_OUT $_;
        }
    }
    close(HTML_IN);
    my $html_out_name = $paths{fileno HTML_OUT};
    close(HTML_OUT);
    rename $html_out_name, $html_in_pth;
    print "javascript updated\n"
}
elsif (!defined $assembling || $assembling == 1) {
    #--------------#
    #  ASSEMBLING  #
    #--------------#
    print "assembling $html_in_pth\n";

    find_css_links($html_in_pth);

    # there are some issues with eol sequences ('<:crlf' can force dos mode)
    open(HTML_IN, '<', $html_in_pth) or die "couldn't open $html_in_pth";

    open_new(\*HTML_OUT, "$output_base_path$output_name", '.html');

    my $state = 0;
    while (<HTML_IN>) {
        if ($state == 0 && $_ =~ /(.*<style[^>]*id="twine-user-stylesheet"[^>]*>)((.*)(<\/style>((.*)<link [^>]*rel=\"stylesheet\"[^>]*>)?(.*)))?/) {
            # $1 matched from the beginning of the line to the end of the opening <style> tag
            if ($2) {
                # the closing </style> tag has been found on the same line and $3 matches the style contents

                print HTML_OUT "$1$3";

                for my $css_in_pth (@css_in_pths) {
                    my ($x1_, $html_in_base_path, $x2_) = fileparse($html_in_pth, (".html"));
                    open(CSS_IN, '<', $html_in_base_path . $css_in_pth);
                    read_and_paste(\*CSS_IN, \*HTML_OUT);
                    close(CSS_IN);
                }

                if ($5) {
                    # $5 matches a <link ...>
                    print HTML_OUT "</style>$6$7\n";
                    $state = 3; # all done - style pasted and removed <link>
                } else {
                    print HTML_OUT $4;
                    $state = 2; # style has been pasted, <link> remains
                }
            } else {
                # the closing </style> tag hasn't been found on this line
                print HTML_OUT $_;
                $state = 1; # found beginning of <style>
            }
        } elsif ($state == 1) {
            # state == 1 => beginning of <style> has already been found

            if ($_ =~ /(.*)<\/style>((.*)<link [^>]*rel=\"stylesheet\"[^>]*>)?(.*)/) {
                # found the closing tag </style>
                # $1 matches anything before it
                # $4 matches anything behind it or behind a following <link> tag

                print HTML_OUT "$1\n";
                
                for my $css_in_pth (@css_in_pths) {
                    my ($x1_, $html_in_base_path, $x2_) = fileparse($html_in_pth, (".html"));
                    open(CSS_IN, '<', $html_in_base_path . $css_in_pth);
                    read_and_paste(\*CSS_IN, \*HTML_OUT);
                    close(CSS_IN);
                }

                print HTML_OUT "<\/style>";
                if ($2) {
                    # <link ...> has been matched, $4 matches anything between </style> 
                    print HTML_OUT "$3$4\n";
                    $state = 3; # all done - style pasted and leaved out the <link ...>
                } else {
                    # <link ...> has not been matched on this line
                    print HTML_OUT "$4\n";
                    $state = 2; # style pasted but <link ...> is still present somewhere
                }
            } else {
                # </style> has not been found yet
                # copying over the style from HTML_IN 
                print HTML_OUT $_;
            }
        } elsif ($state == 2 && $_ =~ /(.*)<link [^>]*rel=\"stylesheet\"[^>]*>(.*)/) {
            print HTML_OUT "$1$2";
            $state = 3; # <link> has been removed
        } else {
            print HTML_OUT $_;
        }
    }

    close(HTML_IN);
    my $html_out_name = $paths{fileno HTML_OUT};
    close(HTML_OUT);

    print "assembled into $html_out_name\n";
    exit 0;
}
else {
    #-----------------#
    #  DISASSEMBLING  #
    #-----------------#
    print "disassembling $html_in_pth\n";

    open(HTML_IN, '<', $html_in_pth);

    open_new(\*CSS_OUT, "${output_base_path}style-$output_name", '.css');
    open_new(\*HTML_OUT, "$output_base_path$output_name", '.html');

    my $non_empty_found = 0;
    my $in_style = undef;
    while (<HTML_IN>) {
        if (defined $in_style && $in_style == 1) {
            if ($_ =~ /(.*)<\/style>(.*)/) {
                print CSS_OUT $1;
                my $css_pth = $paths{fileno CSS_OUT};
                my $bit_after_style = $2 ? "$2\n" : "";
                print HTML_OUT "\n</style>\n<link href=\"$css_pth\" rel=\"stylesheet\">\n$bit_after_style";
                $in_style = 0;
            } else {
                if (!$non_empty_found && $_ =~ /^\s*$/) {
                    # skipping the first empty lines
                } else {
                    $non_empty_found = 1; # a non-empty line found
                    print CSS_OUT $_;
                }
            }
        }
        elsif (!defined $in_style && $_ =~ /^(.*<style[^<]*id="twine-user-stylesheet"[^<]*>)(.*)$/) {
            # print "!! I have found the style element:\n$_\n$1|---|$2\n";
            print HTML_OUT $1;
            $in_style = 1;
            my $bit_of_css = $2 ? "$2\n" : "";
            # TODO  the annoying extra newline at the beginning (previous fix attempt not great)

            if ($2 =~ /(.*)<\/style>(.*)/) {
                # the style element was closed on the same line as it was opened
                print "Twine user stylesheet was empty\n";
                my $css_pth = $paths{fileno CSS_OUT};
                print HTML_OUT "$1</style>\n<link href=\"$css_pth\" rel=\"stylesheet\">\n$2";
                $in_style = 0;
            } else {
                # the style element was not closed -> write out the CSS
                print CSS_OUT "$bit_of_css";
            }
        } else {
            print HTML_OUT $_;
        }
    }

    close(HTML_IN);
    my $html_out_name = $paths{fileno HTML_OUT};
    close(HTML_OUT);
    my $css_out_name = $paths{fileno CSS_OUT};
    close(CSS_OUT);

    print "disassembled into $html_out_name and $css_out_name\n";
    exit 0;
}



# read from one file and paste to the other
sub read_and_paste { #(\*CSS_IN, \*HTML_OUT)
    my $in = shift;
    my $out = shift;
    while (<$in>) {
        print $out $_;
    }
}


# parse arguments
sub parse_args {
    my $arg = shift;
    while ($arg) {
        if ($arg eq "-h") {
            print_help(); # exits the program
        } elsif ($arg eq "-a") {
            $assembling = 1; # assembling
            $overwrite_dis = 0;
        } elsif ($arg eq "-d") {
            $assembling = 0; # dissasembling
        } elsif ($arg eq "-o") {
            $assembling = 0; # dissasembling
            $overwrite_dis = 1; # overwrite source file
            $safe_open = 0; # force open files
        } elsif ($arg eq "-js") {
            $javascript = shift; # replacing 'user javascript' in original the twine file
        } elsif ($arg eq "-f") {
            $safe_open = 0; # force opening files
        } elsif ($arg eq "-s") {
            $safe_open = 1; # use the safe open subrutine
        } else {
            push(@files, $arg);
        }
        $arg = shift;
    }

    $html_in_pth = $files[0];

    if ($html_in_pth =~ /.*\.html/) {
    } else {
        die "first file argument does not have html extension";
    }

    if (defined $files[1]) {
        # user given output file name
        my ($name, $base_path, $ext_) = fileparse($files[1], (".html", ".css"));
        $output_name = $name;
        $output_base_path = $base_path;
    
    } elsif ($overwrite_dis) {
        # make a copy for reading
        copy($html_in_pth, "${html_in_pth}.orig") or die "Copying input file failed: $!";
        print("saving a copy of $html_in_pth as ${html_in_pth}.orig\n");

        # set variables for overwriting the input file
        my ($name, $base_path, $ext_) = fileparse($html_in_pth, (".html"));
        $html_in_pth = "${html_in_pth}.orig";
        $output_name = $name;
        $output_base_path = $base_path;

    } else {
        # output file name based on the input name
        my ($name, $base_path, $ext_) = fileparse($html_in_pth, (".html"));
        
        $output_name = defined $assembling && $assembling == 0 ? "$name-d" : "$name-a";
        if (defined $assembling && $assembling == 0 && "$name" =~ /(.*)-a(_\d+)?/) {
            # remove the '-a' sufix if disassembling
            $output_name = $1;
        }

        $output_base_path = $base_path;
    }
}


# finds linked css files
sub find_css_links {
    my $html_in_pth = shift;
    open(HTML_IN_, '<', $html_in_pth) or die "couldn't open $html_in_pth";
    while (<HTML_IN_>) {
        if ($_ =~ /.*<link [^>]*href=\"([^\"]*)\"[^>]*rel=\"stylesheet\"[^>]*>.*/) {
            print "found linked css file: $1\n";
            push(@css_in_pths, $1);
        } elsif ($_ =~ /.*<link [^>]*rel=\"stylesheet\"[^>]*href=\"([^\"]*)\">.*/) {
            print "found linked css file: $1\n";
            push(@css_in_pths, $1);
        }
    }
    close(HTML_IN_);
}


# prints help message and !exits!
sub print_help {
    print $usage . "\n" .
    "  -a       assembly mode [default]\n" .
    "  -d       disassembly mode\n" .
    "  -o       disassemble and overwright the input file\n" .
    "  -js PTH  replace user javascript in the original\n" .
    "           twine html with contents of PTH\n" .
    "  -s       safe open (new files are numbered\n" .
    "           if same name already exists) [deafult]\n" .
    "  -f       no safe open\n" .
    "  -recover NAME\n" .
    "           #TODO  replaces the current file *.html by the *.html.orig \n" .
    # "#TODO ...\n" .
    "";
    exit 0;
}


sub open_new {
    my $fh = shift; # file handle
    my $new_pref = shift; # part of the file path
    my $new_suf = shift; # extension

    if ($safe_open && !$overwrite_dis && -e "${new_pref}${new_suf}") {
        my $no = 1;
        while (-e "${new_pref}_${no}${new_suf}") {
            $no = $no + 1;
        }
        open($fh, '>', "${new_pref}_${no}${new_suf}") or die $!;
        $paths{fileno $fh} = "${new_pref}_${no}${new_suf}";
    } else {
        if ("${new_pref}${new_suf}" eq $html_in_pth) {
            die "can't open $html_in_pth for writing because it is needed for reading\n" .
            "use safe open option\n";
        }
        open($fh, '>', "${new_pref}${new_suf}") or die $!;
        $paths{fileno $fh} = "${new_pref}${new_suf}";
    }
}