#!/usr/bin/perl -w

# NOTE: If you are trying to download this script, please press your
# browser's "Back" button, and right-click on the link, selecting "Save
# Link As..." or "Save Target As..." to save this script to your disk.

# NOTE: If you have installed this script in your CGI area and see this
# displayed in your web browser, it means your web server does not
# recognize this as a script to be executed. Try adding a .cgi or .pl
# extension to the filename, then give it another shot. (And on unix-like
# systems (e.g. linux, Mac OS X, Solaris), make sure the file has execute
# permission set.)

# NOTE: if you need to change the path to perl in the very first line
# above, remember to do the same for the Calcium.pl file that gets
# installed.




# Simplified Installation Script
# If no write perm in current dir, just warn and exit.
# If tar file not present, retrieve either the .tar or .tar.gz file from BBSW.
# Extract it into the cgi-bin dir, or wherever we're sitting.
# And that's it.

use strict;
use CGI::Carp qw(fatalsToBrowser set_message);
use 5.004;
use CGI 2.42;
use File::Copy;
use Cwd;

$|++;

my $version_name = '4.0';
my $tarFile = 'Calcium40.tar';  # will be .gz if Compress::Zlib module exists
my $script  = 'Calcium40';
my $baseURL = "http://www.brownbearsw.com/calcium/download";
my $tarURL  = "$baseURL/$tarFile";
my $thisDir = cwd || '.';
my $instDir = "$thisDir/CalciumDir40";

my $styles = <<ENDCSS;
body {background-color: #d9d2d9;
      background-image: url(http://brownbearsw.com/images/background-paw.jpg);
      font-family:      verdana,arial,helvetica;
      margin:           50px;
      margin-top:       10px;}
.bottomNotes {font-size: smaller;}
ENDCSS

my $cgi = CGI->new;
print $cgi->header;
print $cgi->start_html (-title   => "Calcium $version_name Installer",
                        -style   => {-code => $styles});
print $cgi->h1 ("<center>Calcium $version_name Installer</center>");

# First, see if we've got Tar, (and Zlib)
my ($perlTar, $tarCommand);
if (eval {require Archive::Tar}) {
    $perlTar++;
} elsif (-x '/bin/tar' or -x '/usr/bin/tar') {
    $tarCommand = (-x '/bin/tar') ? '/bin/tar' : '/usr/bin/tar';
} else {
    quit (qq {<p>Sorry, your server can\'t seem to handle 'tar' files;
              you can\'t use this installer.</p> <p>Simple installation
              instructions can be found here: <a href="$baseURL">Brown Bear
              Software</a></p>});
}

my $tarSize = '2 megabytes';
my ($haveZlib, $gzCommand);
if ($perlTar) {
    if (eval {require Compress::Zlib}) {
        $haveZlib = 1;
    }
} elsif (-x '/bin/gunzip') {
    $haveZlib = 1;
    $gzCommand = '/bin/gunzip';
} elsif (-x '/usr/bin/gunzip') {
    $haveZlib = 1;
    $gzCommand = '/usr/bin/gunzip';
}
if ($haveZlib) {
    $tarFile .= '.gz';
    $tarSize = '500K bytes';
}

$tarURL = "$baseURL/$tarFile";



# Check for write permission
if (!-w $thisDir) {
    my $uname;
    eval {$uname = getpwuid ($>)};
    $uname = $uname ? "('$uname')" : '';
    quit (qq {<b>Problem:</b> Not allowed to write to the current directory
              on the web server: <b>$thisDir</b>

              <p>This script must be run from a directory that is writable.
              The user that the web server runs as $uname needs write
              permission.</p>

              <p><b>Solution:</b> Change file permissions on the directory.
              If you can\'t do that, try creating a new directory (e.g.
              <b>$thisDir/BrownBear</b>), make sure the user the web server
              runs as has write permission there, then move this script
              into that dir and browse to it.</p>});
}

if ($cgi->param ('Retrieve')) {
    print "<p>Retrieving package `$tarFile' from Brown Bear Software; " .
          "please wait...</p>\n";
    require LWP::Simple;
    my $status = LWP::Simple::getstore ($tarURL, "$thisDir/$tarFile");
    if (HTTP::Status::is_error ($status)) {
        quit ("Couldn't retrieve the file; result: " .
               HTTP::Status::status_message ($status) .
               "<p>Please get the Calcium installation package '$tarFile', " .
               "put in the '$thisDir' directory, then try again.</p>" .
               "<p>You can download the package <a href=$tarURL>here.</a>");
    }
}

# Exit if already installed.
foreach (qw /Calendar Operation/) {
    if (-e "$instDir/$_") {
        print qq {<p>A Calcium installation already exists in <b>
                  $instDir</b></p>
                  <p>Please remove or rename it, and try again.</p>};
    print $cgi->end_html;
    exit;
    }
}

if (!-e $tarFile) {
    if (eval {require LWP::Simple}) {
        print qq {<p>Thanks for trying Calcium!</p>
                  <p>Press this button to automatically retrieve
                  and install Calcium:</p>};
        print $cgi->startform;
        print '&nbsp;&nbsp;&nbsp;';
        print $cgi->submit (-name  => 'Retrieve',
                            -Value => 'Go Get Calcium');
        print '&nbsp;&nbsp;&nbsp;';
        print qq {<small>(The package is about $tarSize, so it will
                  take a few moments to download.)</small>};
        print $cgi->endform;
        print '<br><br>';

        print '<hr width="90%">';
        print qq {<div class="bottomNotes">
                  <p>Or, you can get the package yourself from this link:</p>
                  <p style="margin-left: 20px;"><a href=$tarURL>$tarURL</a></p>

                  <p>Save it in the same place as this script ('$thisDir'),
                  then reload this page to install it.</p></div>};

        print $cgi->end_html;
        exit;
    } else {
        quit (qq {The Calcium installation package '$tarFile' isn\'t
                  here, and the Perl installation on this server doesn\'t
                  have the library needed to retrieve it automatically.
                  <p>You can get the package <a href=$tarURL>here.</a>
                  <small>(Right-click, choose "Save As...")</small> </p>
                  <p>Please copy it to the '$thisDir' directory and try
                  again by reloading this page.</p>},
              1);
    }
}

quit ("Calcium installation package '$tarFile' exists but is not readable!\n")
    if (-e $tarFile and !-r $tarFile);

print "<p>Extracting package `$tarFile'...</p>\n";

if ($perlTar) {
    # Need to ensure dirs are writable, or extraction fails...
    my $tar = Archive::Tar->new ($tarFile, $haveZlib);
    my @filenames = $tar->list_files;
    foreach (@filenames) {
        $tar->extract ($_);
        chmod 0755, $_ if (-d $_);
    }
} else {
    my $output = '';
    if ($gzCommand) {
        $output = `$gzCommand -c $tarFile | $tarCommand xf - 2>&1`;
    } else {
        $output = `$tarCommand xf $tarFile 2>&1`;
    }
    quit ("extraction failed! $output") if $?;
}

# Use whatever extension we're running with (if any) for the script
use File::Basename;
my ($base, $path, $ext) = fileparse ($0, '\.[^.]*$');     # '
my $scriptName = $script . $ext;
rename ("$script.pl", $scriptName)
    if ("$script.pl" ne $scriptName);

print "Done!\n";
print $cgi->h3 ('The Calcium installation was successful.');

my $url = $cgi->url;
my $myName = $cgi->url (-relative => 1);
$myName ||= 'CGI module is broken, oh well';
$url =~ s/$myName/$scriptName/;
print $cgi->p (' Follow this link ' . $cgi->a ({href => $url}, $url) .
               " to go to Calcium.");
print $cgi->end_html;


# ----------------------------------------------------------------------
sub quit {
    my ($message) = @_;
    print $message;
    print $cgi->end_html;
    exit;
}