#!/usr/bin/perl
#require 5.008;
our $VERSION = "0.01"; # 2010-04-08

# In order to handle pages with malformed MIME Type of HTTP header, 
# wget an HTML file from the specified URI, add a base tag to the HTML file,
# and let firefox read it remotely on a new tab.

use utf8;
use strict;
use warnings;
use File::Spec;
use URI::file;
use URI::Split qw(uri_split uri_join);

our $FIREFOX = "c:/Program Files/Mozilla Firefox/firefox.exe";
our $WGET = "c:/cygwin/bin/wget.exe";
our $USE_CYGPATH = 0;
our $TMP = File::Spec->catfile($ENV{TEMP}, "wget_addbase_firefox_tmp.html");
if ($^O =~ /cygwin/i ) {
  if ($USE_CYGPATH) {
    $TMP = `cygpath -a -m $TMP`;
    $TMP =~ s/[\x0d\x0a]+$//;
  } else {
    $TMP =~ s(^\/cygdrive\/([a-zA-Z])\/){uc($1). ":/"}se;
  }
}
our $FILESYS = ($^O =~ /cygwin/i)? "win32" : $^O;

die "Usage: $0 URL\n" if @ARGV < 1;

my $URL = shift @ARGV;

system($WGET, "-O", $TMP, $URL);
open(FILE, "<", $TMP) or die $!;
my $CONT = join("", <FILE>);
close(FILE);

if ($CONT =~ /(\<\s*head\s*\>)(.*)(\<\s*\/\s*head\s*\>)/is) {
  my $pre = $` . $1;
  my $post = $3 . $';
  my $head = $2;
  if ($head !~ /\<\s*base\s*href/is) {
    my $base = $URL;
    my ($scheme, $auth, $path, $query, $frag) = uri_split($URL);
    if ($path !~ /\/$/) {
      $path =~ s/\/[^\/]*$/\//;
    }
    $base = uri_join($scheme, $auth, $path, $query, $frag);
    my $prenewline = "";
    $prenewline = $1 if $head =~ /^(\n*)/s;
    $head = $prenewline .= "<base href=\"" . $base . "\" />\n" . $head;
  }
  $CONT = $pre . $head . $post;
}
open(FILE, ">", $TMP) or die $!;
print FILE $CONT;
close(FILE);
my $TMPURI;
if ($^O =~ /cygwin/i && ! $USE_CYGPATH) {
  $TMPURI = "file:///" . $TMP;
} else {
  $TMPURI = URI::file->new_abs($TMP, $FILESYS);
}
system($FIREFOX, "-remote", "openURL($TMPURI, new-tab)");