# Main Installation Wizard class. 
# Why are you looking at this source code? There's nothing interesting in here!
#
package install::Wizard;

use strict;
use util;
use File::Spec::Functions qw(:ALL);
use Data::Dumper;
require PS;

our $first = undef;

sub new {
  #  return $first if defined $first;			# return first object if it already exists
  if (defined $first) {
    return $first;
  }

  my ($class, $args) = @_;
  my $self = { 
	classname 	=> $class, 
	data		=> {},						# data for wraptext()
	ftp 		=> undef,					# reference to an Net::FTP object
	ftproot		=> '',
	lang		=> {},
	conf		=> {},
	args		=> $args || {},
	OS		=> $^O,
  };

  # setup some common global data variables for use in wraptext()
  $self->{data} = {
	'psversion'	=> $PS::VERSION,
	'psver'		=> $PS::VERSION,
  };
  bless($self, $class);

  # determine maximum width of the terminal/screen. Wrap it in an eval to trap fatal errors
  eval "use Term::ReadKey qw(GetTerminalSize)";
  if (!$@) {
    $self->{readkey} = 1;
    my ($width, $height) = GetTerminalSize(\*STDOUT);
    $self->{SCREENWIDTH} = $width ? $width - 1 : 79;
    $self->{SCREENHEIGHT} = $height ? $height - 1 : 24;
  } else {
    $self->{readkey} = 0;
    $self->{SCREENWIDTH} = 79;
    $self->{SCREENHEIGHT} = 24;
    $self->wraptext([
	"NOTE: Your system does not have the perl module Term::ReadKey installed. This installation wizard is enhanced ",
	"with Term::ReadKey installed. It is recommened you install it and then re-run the install wizard. This is OPTIONAL ",
	"and you do NOT have to do this in order for the install wizard to finish\n"
    ]);
  }

  $first = $self;
  return $self;
}

# -------------------------------------------------------------------------------------------------------------------------------
sub remove_state_source {
  require PS::Scanner;				# we do this here since it's not required anywhere else...
  my ($self, $source) = @_;
  my $state = PS::Scanner->load_state();	# get the current state information
  my @list = ref $source ? @$source : ( $source );
  foreach my $src (@list) {
    if (exists $state->{source}{$src}) {
      delete $state->{source}{$src};
    }
  }
  PS::Scanner->save_state($state, 1);		# saves the state (just refreshes it)
}
# -------------------------------------------------------------------------------------------------------------------------------
# makes sure we have a valid connection to the FTP server. If we're already connected this simply returns the ftp reference(true)
sub ftpconnect {
  my ($self) = @_;
  my $in = $self->{conf}{install};
  my $lang = $self->{lang};

  return $self->{ftp} if $self->{ftp} and $self->{ftp}->pwd;		# are we already connected?
  undef $self->{ftp};

  %{$self->{data}} = ( %{$self->{data}}, %$in );
  eval { require Net::FTP };
  if ($@) {					# if true there was an error with loading Net::FTP
    $self->{data}{error} = $@;
    $self->wraptext($lang->{netftp});
    exit(1);					# we have to exit since Net::FTP is required at this point
  } else {
    $self->wraptext($lang->{ftpconnect});
    $self->{ftp} = new Net::FTP($in->{webhost}, Port => $in->{ftpport}, Passive => $in->{ftppasv}, Debug => $in->{ftpdebug}, Timeout => 10);
    my $ftpvalid = ($self->{ftp} and $self->{ftp}->login($in->{ftpuser}, $in->{ftppass}));
    if (!$ftpvalid) {
      $self->{data}{error} = (defined $self->{ftp}) ? $self->{ftp}->message : $lang->{unknownerror} || 'Unknown Error';
      chomp($self->{data}{error});
      $self->wraptext($lang->{ftperror});
      return 0;
    }
    $self->{data}{ftpcwd} = $self->{ftproot} = $self->{ftp}->pwd;
    $self->wraptext($lang->{ftpconnected});
  }
  return $self->{ftp};
}
# -------------------------------------------------------------------------------------------------------------------------------
sub ftpuploadfiles {
  my ($self, $files, $destpath) = @_;
  my $ftp = $self->{ftp};
  my $lang = $self->{lang};
  my %created = ( '' => 1 );
  my $sum = 0;
  my $total = @$files;		# total # of files
  my $ok = 1;
  my $dirsep = index($destpath, '/') != -1 ? '/' : '\\';
  my $destfile;

#  print $destpath,"\n"; exit;
  $ftp->cwd($destpath);								# start in destination
  foreach my $file (@$files) {
    $sum++;

    $destfile = $file;
    $destfile =~ s/^themes.//;							# remove 'themes/' from start of string
#    print "dest: $destfile\n";

    my ($vol, $path, $filename) = splitpath($destfile);
    if ($path and !$created{$path}) {
      $created{$path} = 1;
      $ftp->mkdir($self->unixpath($path), 1);					# create the directory path
      chomp($self->{data}{error} = $ftp->message);
#      print "Created: " . $self->unixpath($path), "\n";
    }

    # upload the file ....
    $self->{data}{file} = ($self->{SCREENWIDTH} <= 95) ? $filename : $destfile;		# only display the filename if the screen is too narrow
    $self->{data}{filesize} = sprintf("%10s", abbrnum(-s $file,2));
    $self->{data}{pct} = sprintf("%6s", calcpct($sum, $total));
    $self->wraptext($lang->{ulfile}, {trimtail => 1});

    my $ok = $ftp->put($file, $destfile);
    chomp($self->{data}{error} = $ftp->message) if !$ok;
    $self->wraptext( $ok ? $lang->{ok} : $lang->{ulfileerr} );
  }
  return $ok;
}
# -------------------------------------------------------------------------------------------------------------------------------
sub ftpidle {
  my ($self) = @_;
  $self->{ftp}->pwd if defined $self->{ftp};
}
# -------------------------------------------------------------------------------------------------------------------------------
sub ftpcwdroot {
  my ($self) = @_;
  $self->{ftp}->cwd( $self->{ftproot} ) if defined $self->{ftp};
}
# -------------------------------------------------------------------------------------------------------------------------------
# very basic text wrapping function.
# writes the text to the screen, wrapping at the column specified (79 by default). $text can be a single scalar or an array ref
# of scalar strings. If an array ref is passed all scalars within the array are added together as 1 large paragraph.
sub wraptext {
  my ($self, $text, $opts, $data) = @_;
  my ($line, @lines, $maxcols, $output, $tail);
  $text = "*** Undefined language string used in " . (caller)[1] . " at or near line # " . (caller)[2] . " ***" unless defined $text;
  my $buf = join('', ref $text eq 'ARRAY' ? @$text : ($text));			# join all lines together
  $opts = {} unless defined $opts;
  $maxcols ||= $opts->{maxcols} || $self->{SCREENWIDTH} || 79;
  $data ||= {};
  @lines = ();
  $output = '';

  $buf =~ s/\s{2,}/ /g;									# convert 2+ spaces into single space
  $buf =~ s/\\n/\n/g;									# convert literal "\n" into newline
  $buf =~ s/&nbsp;/ /gi;								# convert literal "&nbsp;" into a space
  $buf =~ s/&pound;/#/gi;								# convert literal "&pound;" into a #
  $buf =~ s/\\s(\d*)/' ' x ($1 || 1)/ge;						# convert literal "\sXXX" into spaces
  $buf =~ s/\\t/' ' x 8/ge;								# convert literal "\t" into 8 spaces
  $buf = simple_interpolate($buf, { $self->{conf} ? %{$self->{conf}} : (), $self->{data} ? %{$self->{data}} : (), %$data });

  $tail = '';
  $tail = $1 if $buf =~ s/(\r?\n)+$//;						# capture trailing newlines

  @lines = split(/\n/, $buf);							# split phyiscal lines apart

  foreach my $b (@lines) {
    $output .= "\n" if $b eq '';
    while ($b ne '') {
      $line = substr($b, 0, $maxcols, '');
      if (length($line) >= $maxcols and $line !~ /^\S+$/) {	# if line >= maxcols and the line is NOT solid non-whitespace
        while ($line !~ /[-\s]$/) {				# while the last char is not whitespace or a dash
          $b = substr($line, -1, 1, '') . $b;			# remove the last char and put it back on to the buffer
        }
      }
      $output .= $line . "\n";
    }
  }

  $output .= $tail if $tail ne '';
  if ($output ne '') {
    $output =~ s/\s+$// if $opts->{trim} or $opts->{trimtail} or $opts->{trimright};	# strip off trailing whitespace
    $output =~ s/^\s+// if $opts->{trim} or $opts->{trimhead} or $opts->{trimleft};	# strip off leading whitespace
    print $output;
  }
}
# -------------------------------------------------------------------------------------------------------------------------------
BEGIN { 
  eval { require Term::ReadLine };
  my $term = !$@ ? new Term::ReadLine 'PS2 Install' : undef;
  my $laststr = "";
  my $dohist = defined $term && !$term->Features->{autohistory};
  eval "use Term::ReadKey";
  my $readkey = !$@;			# Did Term::ReadKey initialize successfuly?
  sub _prompt {				# internal function to handle the actual prompting
    my ($self, $prompt, $nopound) = @_;
    my $res;
    $nopound = 1 unless defined $nopound;

    while (1) {
      if (defined $term) {
        $res = $term->readline($prompt);
        # add it to the history, so the user can up-arrow to it later, if desired (and if their readline supports it)
        # only add to history if there's SOMETHING in the response and its not the same as the last input (and autohistory isn't on)
        $term->addhistory($res) if $dohist and defined $res and $res =~ /\S/ and $laststr ne $res;
      } else {
        print $prompt;
        chomp($res = <STDIN>);
      }
      last unless $nopound;		# if true then we need to check it below ... otherwise we exit the loop
      if ($res =~ /#/) {
        $self->wraptext($self->{lang}->{invalidinput});
      } else {
        last;
      }
    }
    $res = defined $res ? $self->trim($res) : undef;
    $laststr = $res if defined $res;
    return $res;
  }
  # -----------------------------------------------------------------
  sub promptfor {
    my ($self, $prompt, $default) = @_;
    $default = '' unless defined $default;
    if ($self->{args}{useconfonly}) {
      print ">>> $prompt$default\n";
      return $default;
    }
    my $res = $self->_prompt($prompt);
    return (defined $res and $res ne '') ? $res : $default;
  }
  # -----------------------------------------------------------------
  sub promptfor_password {
    my ($self, $prompt, $default) = @_;
    $default = '' unless defined $default;
    if ($self->{args}{useconfonly}) {
      print ">>> $prompt$default\n";
      return $default;
    }
    my $res = $self->_prompt($prompt);
    return (defined $res and $res ne '') ? $res : $default;
  }
  # -----------------------------------------------------------------
  sub promptfor_forced {
    my ($self, $prompt, $default, $pattern, $errstr) = @_;
    my $res;
    $default = '' unless defined $default;
    if ($self->{args}{useconfonly}) {
      print ">>> $prompt$default\n";
      return $default;
    }
    while (1) {
      $res = $self->_prompt($prompt);
      $res = $default if $res eq '';
      last if $res !~ /$pattern/;             # input must NOT match the regexp pattern
      $self->wraptext($errstr || $self->{lang}->{invalidresponse});
    }
    return (defined $res and $res ne '') ? $res : $default;
  }
  # -----------------------------------------------------------------
  sub confinput { 
    my ($self, $opt, $sub) = @_;       
    my $t = "";  
    my $var = uc($sub ? "$sub.$opt" : $opt);
    my $prompt = "$var []: ";
    my $def = undef;
    $def = $sub ? $self->{conf}{$sub}{$opt} : $self->{conf}{$opt} if $opt;
    $term->addhistory($def) if defined $def and $def =~ /\S/ and $laststr ne $def;
    if ($sub) {   
      $prompt = "$var [" . $self->{conf}{$sub}{$opt} . "]: " if $opt;
    } else {      
      $prompt = "$var [" . $self->{conf}{$opt} . "]: " if $opt;
    }
    return $self->_prompt($prompt);
  }
  # -----------------------------------------------------------------
  # Get a yes or no response from the user
  sub prompt_yesno {
    my $self = shift;
    my $default = shift || 0;
    my $prompt = shift || "> ";
    my $prompterr = shift || $self->{lang}->{yesorno} . "\n";
    my $forceallowed = shift || 0;
    my $result = undef;
    $prompt .= sprintf(" [%s]: ", $default ? "Y,n" : "y,N");

    if ($forceallowed and $self->{args}{useconfonly}) {
      my $yn = $self->{args}{yes} || !$self->{args}{no} || $default;
      print ">>> $prompt" . ($yn ? 'YES' : 'NO') . "\n";         
      return $yn;
#      return 1 if $self->{args}{yes};		# was 'YES' forced?
#      return 0 if $self->{args}{no};		# was 'NO' forced?
#      return $default;				# just use the default...
    }

    while (!defined $result) {
      my $in = lc $self->trim($self->_prompt($prompt));
      if ($in =~ /^(yes|ye?)$/) {
        $result = 1;
      } elsif ($in =~ /^(no?)$/) {
        $result = 0;
      } elsif ($in eq '') {
        $result = $default;
      } else {
        print $prompterr;
      }
    }
    return $result;
  }
  # -----------------------------------------------------------------
  sub pause {
    my ($self, $force, $msg) = @_;
    if ($^O eq "MSWin32" or $force) {
      if (0 and $readkey) {				# note to self: remove '0 and' at some point ...
        $msg ||= "Press a key to continue ...";
        $self->wraptext($msg);
        ReadMode(4);
        my $key = ReadKey(0);		# wait for any key press
        ReadMode(0);
      } else {
        $msg ||= "Press enter to continue ...";
        $self->wraptext($msg);
        my $waitforenter = <STDIN>;
      }
    }
  }
}
# -------------------------------------------------------------------------------------------------------------------------------
sub get_ftp_info {
  my ($self, $in, $silent, $force) = @_;
  my $lang = $self->{lang};
  $in ||= $self->{conf}{install};
  $force ||= 0;

  return if !$force and $self->{got_ftp};		# we only need this information once during an install 
  $self->{got_ftp} = 1;					# this function is called a couple times during the install

#  $self->{data}{webhostip} = gethostip($in->{webhost}) || 'DNS lookup failed';

  while (1) {
    $self->wraptext($lang->{init_webhost}) unless $silent;
    $in->{webhost} = lc $self->promptfor_forced("Web server hostname [$in->{webhost}]: ", $in->{webhost}, '\\s|:|\\/');
    $in->{webhost} = 'localhost' if $in->{webhost} =~ /^\d+\.\d+\.\d+\.\d+$/ and ip2int($in->{webhost}) == 2130706433;
    $self->{data}{webhostip} = gethostip($in->{webhost}) || undef;
    if (!defined $self->{data}{webhostip}) {
      $self->wraptext($lang->{init_badwebhost});
    } else {
      last;
    }
  }

  if ($in->{webhost} ne 'localhost') {
    $self->wraptext($lang->{init_ftpuser});
    $in->{ftpuser} = $self->promptfor("FTP Username [$in->{ftpuser}]: ", $in->{ftpuser});

    $self->wraptext($lang->{init_ftppass});
    $in->{ftppass} = $self->promptfor("FTP Password [$in->{ftppass}]: ", $in->{ftppass});

    $self->wraptext($lang->{init_ftpport});
    $in->{ftpport} = $self->promptfor("FTP Port [$in->{ftpport}]: ", $in->{ftpport});

    $self->wraptext($lang->{init_ftppasv});
    $in->{ftppasv} = $self->promptfor_forced("FTP Passive Mode [$in->{ftppasv}]: ", $in->{ftppasv}, '[^01]');
  }

  %{$self->{data}} = ( %{$self->{data}}, %$in );
  return $self;
}
# -------------------------------------------------------------------------------------------------------------------------------
sub get_ftp_chroot_prefix {
  my ($self, $in, $force) = @_;
  my $lang = $self->{lang};
  $in ||= $self->{conf}{install};
  $force ||= 0;
  return $self if !$force and $self->{got_ftpchroot};
  if ($in->{webhost} ne 'localhost') {
    $self->wraptext($lang->{init_ftpchroot});
    $in->{ftpchroot} = $self->promptfor("FTP non-chroot prefix [$in->{ftpchroot}]: ", $in->{ftpchroot}); 
    $self->{got_ftpchroot} = 1;
  }
  %{$self->{data}} = ( %{$self->{data}}, %$in );  
  return $self;
}
# -------------------------------------------------------------------------------------------------------------------------------
sub get_dir_info {
  my ($self, $in, $silent) = @_;
  my $lang = $self->{lang};
  $in ||= $self->{conf}{install};
  $self->get_installdir($in, $silent);
  $self->get_compiledir($in, $silent);
  %{$self->{data}} = ( %{$self->{data}}, %$in );  
  return $self;
}
# -------------------------------------------------------------------------------------------------------------------------------
sub get_installdir {
  my ($self, $in, $silent) = @_;
  my $lang = $self->{lang};
  $in ||= $self->{conf}{install};
  $self->wraptext($lang->{init_themedir}) unless $silent;
  $in->{themedir} = $self->promptfor("Theme directory [$in->{themedir}]: ", $in->{themedir});
  %{$self->{data}} = ( %{$self->{data}}, %$in );
  return $self;
}
# -------------------------------------------------------------------------------------------------------------------------------
sub get_compiledir {
  my ($self, $in, $silent) = @_;
  my $lang = $self->{lang};
  $in ||= $self->{conf}{install};
  $self->wraptext($lang->{init_compiledir}) unless $silent;
  $in->{compiledir} = $self->promptfor("Compiled theme directory [$in->{compiledir}]: ", $in->{compiledir});
  %{$self->{data}} = ( %{$self->{data}}, %$in );
  return $self;
}
# -------------------------------------------------------------------------------------------------------------------------------
# quick 'unix' version of catfile() that someonewhat mimics the File::Spec::Functions::catfile. Converts all \ to /
# returned string never has a trailing '/'
sub unixpath {
  my $self = shift;
  my @args = @_;
  my $path = "";
  foreach my $arg (@args) {
    next unless defined $arg;
    $arg =~ s|\\|/|g;							# convert all \ to /
    $path .= $arg;
    $path .= "/" unless substr($path, -1) eq '/';
  }
  $path = substr($path, 0, -1) if substr($path, -1) eq '/';		# remove the trailing /, if present
  $path =~ s|/{2}|/|g;							# condense multiple // to /
  return $path;
}
# -------------------------------------------------------------------------------------------------------------------------------
sub trim {
  my ($self, $str) = @_;
  $str =~ s/^\s+//;
  $str =~ s/\s+$//;
  return $str;
}
# -------------------------------------------------------------------------------------------------------------------------------



1;