#!/usr/bin/perl

die "This installer need not (and should not) be run as root.\n\n" .
    "Sysexy does not do anything that requires special permissions,\n" .
    "thus it\'s probably better to just install as a regular user in\n" .
    "your home directory.  That\'s what this installer will do.\n\n" .
    "If you\'re root, or using sudo, try again without it.  Feel free\n" .
    "however to create a distro package (DEB, RPM, etc.) that installs\n" .
    "Sysexy sitewide as root.  This installer is for personal use.\n\n"
    if $> == 0;

die "Sysexy currently only runs on Linux.\n" unless $^O eq 'linux';

require 5.14.0 or die "Sysexy requires Perl 5.14 or later.\n";

use warnings;
use strict     'vars';
#   These modules come with Perl:
use File::Path 'make_path';
use File::Copy 'cp';
use Cwd;

die "Sysexy requires Perl/Tk to be installed for graphical interface.\n" .
    "You can probably obtain a package through your distro.\n\n"
    unless eval { require Tk;
		  Tk->import();
		  1; };

my %needfont = ('adobe-times'     => 'Adobe Times',
		'adobe-helvetica' => 'Adobe Helvetica',
		'adobe-courier'   => 'Adobe Courier',
		'misc-fixed'      => 'Misc Fixed');
my @needmod  = ('Config::Simple',
		'List::MoreUtils',
		'MIDI::ALSA');
my $msgtext  =  '';
my ($btn1,  $btn2);

my $mw       = MainWindow->new(
    -title                             => 'Sysexy Installer',
    -background                        => 'gray30');

my $msgarea  = $mw->Label(
    -relief                            => 'sunken',
    -borderwidth                       => 6,
    -foreground                        => 'white',
    -background                        => '#06345b',
    -justify                           => 'left',
    -textvariable                      => \$msgtext)->grid(
    -sticky                            => 'nsew',
    -column                            => 0,
    -columnspan                        => 3,
    -row                               => 0,
    -padx                              => 2,
    -pady                              => 2);

$btn1        = $mw->Button(
    -text                              => 'Ok',
    -relief                            => 'groove',
    -foreground                        => 'gray70',
    -background                        => 'firebrick4',
    -activebackground                  => 'red',
    -activeforeground                  => 'black')->grid(
    -sticky                            => 'ns',
    -column                            => 1,
    -row                               => 1);

$mw->gridRowconfigure(      0, -weight => 1);
$mw->gridColumnconfigure(   0, -weight => 1);
$mw->protocol(WM_DELETE_WINDOW         => \&instend);
$mw->geometry("640x480");
$mw->resizable(0,0);

 INSTALLER: {
     my @xlsfonts = `xlsfonts -u`;
     for my $f (keys %needfont) {
	 unless (grep {$_ =~ /$f/} @xlsfonts) {
	     $msgtext = "$needfont{$f} font package is required but not installed.\n" .
		 "You can almost certainly obtain it through your distro.\n" .
		 "The following packages generally provide the fonts you want.\n\n" .
		 "Debian and Ubuntu: xfonts-100dpi\n\n" .
		 "Gentoo: media-fonts/font-adobe-100dpi, media-fonts/font-misc-misc\n\n" .
		 "Fedora: xorg-x11-fonts-100dpi\n\n" .
		 "On some installations, you may have to logout and log back in to\n" .
		 "make your desktop notice the newly installed fonts.  Install the\n" .
		 "package(s), then run this installer again.";
	     $btn1->configure(-command => \&instend);
	     last INSTALLER;
	 }
     }
     $msgarea->configure(-font         => 'Helvetica -17');

     for (@needmod) {
	 eval "require $_";
	 if ($@) {
	     $msgtext = "Perl module $_ is required but not available.\n\n" .
		 "Check your distro first to see if they provide it as a package,\n" .
		 "and if not, you can install from CPAN on the Internet.\n" .
		 "As root (or prefixed with \"sudo\"), type:\n\n" .
		 "cpan $_\n\n" .
		 "Some flavors of Ubuntu do not have the \"make\" command\n" .
		 "by default, which is used internally by CPAN, and will be\n" .
		 "needed for success if you need to use that method.\n\n" .
		 "If so: \"sudo apt install make\"\n\n" .
		 "Also, Fedora may require you to run\n" .
		 "\"sudo dnf install perl-core\"\n" .
		 "to get a fully functional Perl installation.";
	     $msgtext .= "\n\nThe libasound2-dev (or alsa-lib-devel on Fedora)\n" .
		 "package will probably be needed if you have to\n" .
		 "cpan to get the MIDI::ALSA module." if $_ eq 'MIDI::ALSA';
	     $btn1->configure(-command => \&instend);
	     last INSTALLER;
	 } else {
	     $_->import;
	 }
     }

     $msgtext = "This installer will install Sysexy MIDI Librarian in your home\n" .
	 "directory, using normal user permissions.  Root access is not\n" .
	 "required for anything Sysexy does, so we don\'t want it.\n\n" .
	 "Programs that run as a regular user this way are traditionally\n" .
	 "installed in ~/bin/, which will be created for you if you don\'t\n" .
	 "already have such a folder.  It is recommended that you put\n" .
	 "~/bin in your \$PATH for your usage convenience.\n\n" .
	 "Also, Sysexy has a gear database and icon, which will be\n" .
	 "created in ~/.config/sysexy/.  Later, when the program runs,\n" .
	 "it will also generate its settings file in this location.\n\n\n" .
	 "Click Ok to install, or Cancel to abort without changes.";
     $btn1->configure(-command         => \&pgminst);
     $btn2 = $mw->Button(
	 -text                         => 'Cancel',
	 -relief                       => 'groove',
	 -foreground                   => 'gray70',
	 -background                   => 'gray20',
	 -activebackground             => 'yellow',
	 -activeforeground             => 'black',
	 -command                      => \&instend)->grid(
	 -sticky                       => 'ns',
	 -column                       => 2,
	 -row                          => 1);
}
MainLoop();

sub pgminst {
    my $bindir     = "$ENV{'HOME'}/bin";
    my $cfgdir     = "$ENV{'HOME'}/.config/sysexy";
    my $extractdir = cwd;
    $msgtext       = '';
    $btn2->destroy if Tk::Exists($btn2);

  WORKING: {
      unless (-d $bindir) {
	  if (make_path $bindir) {
	      $msgtext .= "Created ~/bin directory...DONE\n";
	  } else {
	      failmsg("ABORT: Problem creating ~/bin folder!");
	      last WORKING;
	  }
      }
      #  File::Copy documentation claims cp() preserves mode
      #  bits now -- doesn't work here, so let's make sure.
      if ( ( cp("$extractdir/sysexy", $bindir) ) and
	  (chmod 0755, "$bindir/sysexy") ) {
	  $msgtext .= "Installed executable in ~/bin...DONE\n";
      } else {
	  failmsg("ABORT: Cannot install executable in ~/bin!");
	  last WORKING;
      }
      unless (-d $cfgdir) {
	  if (make_path $cfgdir) {
	      $msgtext .= "Created config directory...DONE\n";
	  } else {
	      failmsg("ABORT: Problem creating config directory!");
	      last WORKING;
	  }
      }
      if (cp("$extractdir/geardb", $cfgdir)) {
	  $msgtext .= "Installed default gear database...DONE\n";
      } else {
	  failmsg("ABORT: Cannot setup gear database!");
	  last WORKING;
      }
      # Sysexy will still work without its icon -- not critical.
      if (cp("$extractdir/sysexy.xpm", $cfgdir)) {
	  $msgtext .= "Installed program icon...DONE";
      }
      $btn1->configure(-command        => \&wrapup);
    }
}
sub wrapup {
    $msgtext = "Sysexy MIDI Librarian should be installed now.\n\n" .
	"You can find documentation in this folder, both in\n" .
	"README type text files, and as a \"roff\" format\n" .
	"UNIX manual page, which can be read directly on\n" .
	"Linux with \"man -l sysexy.1\" if you don\'t want\n" .
	"to install it sitewide.  Have fun sysex dumping!";
    $btn1->configure(-command          => \&instend);
}
sub failmsg {
    $msgarea->configure(-background    => 'maroon');
    $btn1->configure(-command          => \&instend);
    $msgtext .= $_[0];
}
sub instend {
    exit;
}
