#!/usr/bin/perl

########## Confixx(R) 3.0 Professional ############
####### Copyright SWsoft, Inc. 2004-2005 ##########
#### http://www.sw-soft.com - info@sw-soft.com ####

use File::Temp;
use File::Basename;
use Cwd;

use lib_module_common;

use vars qw/$wDir $callCounter/;
use strict;

sub loadPackage {
	my $module = shift;

	my ($errmsg,$ret);

	my $file = $module;
	$file =~ s|::|/|g;
	$file .= '.pm';

	return 2 if $INC{$file};

	no strict 'subs';
	
	if ( eval "require $module" ) {
		$module->import();
		$ret = 1; ## OK
	} else {
		$errmsg = $@; ## error
	}	

	use strict 'subs';

	if ( wantarray() ) {
		return ($ret, $errmsg );
	} else {
		return $ret;
	}
}

#
# pakcage's DB (hash): key - name of package
#                      value - array with package's info 
#
# package's info (array): 
#  [0] - name of file/dir
#  [1] - version of package 
#  [2] - hash of requirements (optional)
#  [3] - name of file (optional)
#
# requirements (hash):
#   key - name of package, ('perl' - reserved name)
#   value - version ( for 'perl' the version is numeric )
#
my %dbModules = (
								 'Compress::Zlib' => [ 'Compress-Zlib-1.33',
																			 '1.33',
																			 { 'perl' => 5.004}
																		 ],

								 'Curses' => [ 'Curses-1.08', 
															 '1.08', 
															 { 'perl' => 5.005 }, 
															 'Curses-1.08b.tgz' ],

								 'Curses::UI' => [ 'Curses-UI-0.95',
																	 '0.95',
																	 { 'Curses' => undef,
																		 'Term::ReadKey' => undef 
																	 },
																	 'Curses-UI-0.95.confixx.tar.gz' 
																 ],
								
								 'DBD::Pg' => [ 'DBD-Pg-1.32',
																'1.32',
																{ 'perl' => 5.006001,
																	'DBI' =>  '1.35' 
																}
															],

								 'DBD::mysql' => [ 'DBD-mysql-2.9004',
																	 '2.9004',
																	 { 'DBI' => undef } 
																 ],

								 'DBI' => [ 'DBI-1.46',
														'1.46',
														{'perl' => 5.006,
														 'Test::More' => undef
														}
													],

				 				'Digest' => [ 'Digest-1.10', '1.10',
								 								{ 'MIME::Base64' => undef,
															 	},
															],
				
								'Digest::base' => [ 'Digest-1.10', '1.00',
																		{ 'MIME::Base64' => undef,
																		},
																	 ],


								 'Digest::Perl::MD5' => [ 'Digest-Perl-MD5-1.8', '1.8' ],
	
	 							 'Digest::MD5' => [ 'Digest-MD5-2.33', '2.33',
														{ 'File::Spec' => undef,
															'Digest::base' => 1.00,
														},
												 	],		

				 				'Expect' => [ 'Expect-1.15', 
															 '1.15', 
															 { 'perl' => 5,
																 'IO::Pty' => 0.97,
																 'IO::Tty' => undef 
															 }
														 ],

								 'HTML::Parser' => [ 'HTML-Parser-3.45', '3.45' ],

									'HTML::HeadParser' => [ 'HTML-Parser-3.45', '2.21' ] ,
																
								 'IO::Pty' => [ 'IO-Tty-1.02', '1.02' ],
								 
								 'IO::Socket::SSL' => [ 'IO-Socket-SSL-0.95', 
																				'0.95', 
																				{ 'Net::SSLeay' => 1.08 } ],

								 'IO::Stty' => [ 'IO-Stty-.02', '.02', {'perl' => 5} ],
								 
								 'IO::Tty' => [ 'IO-Tty-1.02', '1.02' ],
								 
								 'IO::Stringy' => [ 'IO-stringy-2.109', '2.109' ],

								 'Logfile::Rotate' => [ 'Logfile-Rotate-1.04','1.04' ],

								 'MIME::Base64' => [ 'MIME-Base64-3.05', '3.05' ],

								 'MIME::QuotedPrint' => [ 'MIME-Base64-3.05', '3.03' ],

								 'MIME::Tools' => [ 'MIME-tools-5.416', '5.416' ],

								 'Mail::Sender' => [ 'Mail-Sender-0.8.10', 
																		 '0.8.10', 
																		 { 'MIME::Base64' => undef,
																			 'MIME::QuotedPrint' => undef 
																		 }
																	 ],

								 'Mail::POP3Client' => [ 'Mail-POP3Client-2.16', 
																				 '2.16',
																				 { 'IO::Socket' => undef } 
																			 ],

								 'Mail::Header' => [ 'MailTools-1.66', 
																		 '1.59', 
																		 { 'perl' => 5.002,
																			 'Net::SMTP' => 1.03,
																	 		'Net::Domain'	=> 1.05,
																			'IO::Handle' => undef,
																	 	 },
																		],

								 'Mail::Mailer' => [ 'MailTools-1.66', '1.66',
																		{ 'Net::SMTP' => 1.03,
																	 		'Net::Domain'	=> 1.05,
																			'IO::Handle' => undef,
																			},
																	 	],

								 'Mail::Send' => [ 'MailTools-1.66', '1.66' ],

								 'Net::DNS' => [ 'Net-DNS-0.48', '0.12' ],
								 
								 'Net::SSLeay' => [ 'Net_SSLeay.pm-1.25', '1.25' ],
								 

								 'Proc::ProcessTable' => [ 'Proc-ProcessTable-0.39',
																					 '0.39', 
																					 { 'perl' => 5.004 }
																				 ],

								 'Quota' => [ 'Quota-1.5.0', '1.5.0' ],

								 'Scalar::Util' => [ 'Scalar-List-Utils-1.14', '1.14' ],

								 'Storable' => [ 'Storable-2.13', '2.13' ],

								 'Term::ReadKey' => [ 'TermReadKey-2.30', '2.30' ],
								
								 'Test::Harness' => [ 'Test-Harness-2.46', '2.46' ],

								 'Test::More' => [ 'Test-Simple-0.54', 
																	 '0.54', 
																	 { 'Test::Harness' => '2.03' }
																 ],	
								
								 'Date::Format' => [ 'TimeDate-1.10', '2.20' ],

								 'URI' => [ 'URI-1.35', '1.35' ],

								 'Unicode::Map8' => [ 'Unicode-Map8-0.12',
																			'0.12',
																			{'Unicode::String' => '2.00' } ],
								 
								 'Unicode::String' => [ 'Unicode-String-2.07', 
																				'2.07', 
																				{ 'MIME::Base64'=> '2.00' } ],

								 'XML::Parser' => [ 'XML-Parser-2.34', '2.34' ],

								 'Net::FTP' => [ 'libnet-1.19', 
																 '2.75', 
																 { 'perl' => 5.001,
																	 'Socket' => 1.3,
																	 'IO::Socket' => undef 
																 }
															 ],

								 'Net::POP3' => [ 'libnet-1.19', 
																 '2.28', 
																 { 'perl' => 5.001,
																	 'Socket' => 1.3,
																	 'IO::Socket' => undef 
													 			},
															],

								 'Net::SMTP' => [ 'libnet-1.19', 
																 '2.29', 
																 { 'perl' => 5.001,
																	 'Socket' => 1.3,
																	 'IO::Socket' => undef, 
																 },
																],

								 'Net::Domain' => [ 'libnet-1.19', '2.19',
																 { 'perl' => 5.001,
																	 'Socket' => 1.3,
																	 'IO::Socket' => undef, 
																 },
															 ],

								 'LWP' => [ 'libwww-perl-5.48',
														'5.48', 
														{ 'perl' => 5.004,
													 		'URI' => 	1.03,
															'HTML::HeadParser' => 2.20,
															'MIME::Base64' => 2.1,
															'Net::FTP' => 2.4,
															'Digest::MD5' => undef,	
														}
													],
							
								 'XML::DOM' => [ 'libxml-enno-1.02', 
																 '1.27', 
																 { 'XML::Parser' => 2.23 }
															 ],
							
);

my @defaultSet = ( 'DBI',
									 "DBD::$dbType",
									 'Logfile::Rotate',
									 'Compress::Zlib',
									 'Net::DNS',
									 'IO::Stringy',
									 'MIME::Base64',
									 'Mail::Sender',
									 'URI',
									 'HTML::Parser',
									 'MIME::Tools',
									 'Mail::Header',
									 'LWP',
									 'Net::Domain',
									 'Date::Format',
									 'Term::ReadKey',
									 'Expect',
									 'IO::Tty',
									 'Net::SSLeay',
									 'IO::Socket::SSL',
									 'Proc::ProcessTable',
									 'Storable',
									 'XML::DOM',
									 'Unicode::Map8',
									 'Curses::UI',
								 );

my $flatMode=0;

sub checkAndInstallFlat {
	my (@check);
	if ( @_ ) {
		my $ptrArr = shift;
		if ( ref($ptrArr) =~ /ARRAY/ ) {
			@check = @{$ptrArr};
		} else {
			unshift @_,$ptrArr;
			@check = @_;
		}
	} else {
		@check = @defaultSet;
		push @check, 'Quota' if $use_quota;
	}
	my (%toCheck,$pkg,$pkgInfo,$ptrReq,$ret);
	foreach $pkg (@check){
		next if exists $toCheck{$pkg};
		$pkgInfo = $dbModules{$pkg};
	  unless ( $pkgInfo ) {
			print STDERR "Error: Package '$pkg' is unknown\n";
			next;
	  }
		$toCheck{$pkg} = $pkgInfo->[1];
		$ptrReq = $pkgInfo->[2];
		if ( ref($ptrReq)=~/HASH/ ){
			&appendRequirement(\%toCheck, $ptrReq);
		}
	}
	$flatMode = 1;
	my $listToCheck = [sort keys %toCheck];
	$ret = &checkAndInstallPkgs( $listToCheck );
	$flatMode = 0;
	if (wantarray()){
		return $ret,$listToCheck;
	} else {
		return $ret;
	}
}

sub appendRequirement {
	my ( $ptrToCheck, $ptrHash ) = @_;
	unless ( ref($ptrToCheck) =~ /HASH/ && ref($ptrHash) =~ /HASH/ ) {
		return undef;
	}
	my ($pkgInfo, $pkg, $ptrReq);
	my $ret=0;
	foreach $pkg (keys %{$ptrHash}) {
		next if exists $ptrToCheck->{$pkg};
		next if $pkg eq 'perl';
		$pkgInfo = $dbModules{$pkg};
	  unless ( $pkgInfo ) {
#			print STDERR "Error: Package '$pkg' is unknown\n";
			next;
	  }
		$ptrToCheck->{$pkg} = $pkgInfo->[1];
		$ret++;
		if ( ref($pkgInfo->[2]) =~ /HASH/ ){
			$ret += &appendRequirement( $ptrToCheck, $pkgInfo->[2]); ## !!! recursion !!!
		}
	}
	return $ret;
}

sub checkAndInstallPkgs {
  my ( @check );
	if ( @_ ) {
		my $ptrArr = shift;
		if ( ref($ptrArr) =~ /ARRAY/ ) {
			@check = @{$ptrArr};
		} else {
			unshift @_,$ptrArr;
			@check = @_;
		}
	} else {
		@check = @defaultSet;
		push @check, 'Quota' if $use_quota;
	}

  my(@toInstall, %installModules);

  @toInstall = &checkPkgs( \@check );

	if ( @toInstall && !$rpm_version_flag ) {
		@toInstall = &confirm( \@toInstall );
	}
	my $ret =1;
	if ( @toInstall ) {
		$ret = &installPkgs( \@toInstall );
  }
	return $ret;
}

sub checkPkgs {
	my $ptrIn = shift;
	unless ( ref($ptrIn)=~/ARRAY/ ){
		unshift @_, $ptrIn;
		$ptrIn = \@_;
	}

	my ($pack,$retCode,$errMsg,$pkgInfo, $ptrRet);
	$ptrRet = [];
	foreach $pack ( @{$ptrIn} ) {
		unless ( &checkPkgVersion($pack) ) {
			push @{$ptrRet}, $pack;
		}
	}
	if ( wantarray() ){
		return @{$ptrRet};
	} else {
		return $ptrRet;
	}
}

sub checkPkgVersion {
	my $pkg = shift;
	my ($pkgVer,$ret, $errMsg, $retCode, $new);  
	if ( @_ ) {
	  ($pkgVer,$new) = @_;
	} else {
	  my $pkgInfo = $dbModules{$pkg};
	  unless ( $pkgInfo ) {
			$errMsg = "Error: Package '$pkg' is unknown\n";
			$ret = undef;
	  }
	  $pkgVer = $pkgInfo->[1];
	}

	unless ( $errMsg ) {
		my ($loadVer);
		my $ptrVer = $pkg.'::VERSION';
		if ( $new ) { ## get version of the now installed package
			unless( $bin_perl && -x $bin_perl ) {
				if ( $^X =~ /perl/ ) {
					$bin_perl = $^X;
				} else {
					$bin_perl = 'perl';
				}
			}

			my $cmd = "$bin_perl -M'$pkg' -e'print \$$ptrVer,\"\\n\"'";
			$loadVer = `$cmd`;
			chomp $loadVer;

		} else { ## get version of the current package
			($retCode, $errMsg) = &loadPackage( $pkg );

			if ( $retCode ) {
	
				return 1 unless $pkgVer;
	
				no strict 'refs';
				$loadVer = ${$ptrVer};
				use strict 'refs';
			}
		}
		if ( $loadVer ) {
			if ( &verNotLess( $loadVer, $pkgVer ) ) {
				$ret = 1;
			} else {
				$ret = 0;
			}	
		} else {
				$errMsg = "Can't get value of $pkg".'::VERSION';
	  }
	}
	if ( wantarray() ) {
	  return $ret, $errMsg;
	} else {
	  return $ret;
	}
}



sub verNotLess ($$) {
	my ($left,$right) = @_;

	my @chunks = map{ /(\d+)/? $1 :0 } split( /\./,$left );
	my $leftVer = $chunks[0] + ( $chunks[1] + $chunks[2] * 0.001) * 0.001;

	@chunks = map{ /(\d+)/? $1 :0 } split( /\./,$right );
	my $rightVer = $chunks[0] + ( $chunks[1] + $chunks[2] * 0.001) * 0.001;

	return ($leftVer >= $rightVer)? 1: 0;
}

sub confirm {
	my $ptrIn = shift;
	unless ( ref($ptrIn)=~/ARRAY/ ){
		unshift @_, $ptrIn;
		$ptrIn = \@_;
	}

	my $ptrRet = [];

  my $lastModule = @{$ptrIn};
  my @toInstall = map{ 1 } @{$ptrIn};

  my ($count, $index, $tickbox, $pkg);
  my $auswahl = -1;
  system("clear");
  while ( ( $auswahl !~ /^\d+$/ ) || ( $auswahl != 0 ) ) {

		print &ltext('install_modules_head', $lastModule);

    print "\n\n";
    $~ = 'MENU';
		
		$count = 0;
		foreach $pkg ( @{$ptrIn} ) {
			$tickbox = $toInstall[$count++]?'[X]':'[ ]';
      $index = "($count)";

      write;
    }
		
		print &ltext('install_modules_promt', &ltext('admin_select_continue'));
    $auswahl = <STDIN>;

	  	chop ($auswahl);
    if ($auswahl =~ /^\d+$/ && $auswahl > 0 && $auswahl <= @toInstall){
	  $toInstall[$auswahl-1] = $toInstall[$auswahl-1]?0:1;
    }
    if ($auswahl !~ /\d+/ || $auswahl != 0 ) {
      system("clear");
    }
  }

format MENU =
@>>> @<<<<<<<<<<<<<<<<<< @<<
$index, $pkg, $tickbox
.

	for ( $count=0; $count < @toInstall; $count++ ) {
		next unless $toInstall[$count];
		push @{$ptrRet},$ptrIn->[$count];
	}

  if ( wantarray() ){
		return @{$ptrRet};
	} else {
		return $ptrRet;
	}
}

my (%preparedPkgs);

sub installPkgs {
	my $ptrIn = shift;
	my (@toInstall);
	if ( ref($ptrIn) =~ /ARRAY/ ){
		@toInstall = @{$ptrIn};
	} else {
		@toInstall = ($ptrIn, @_);
	}

	return 1 unless @toInstall;

	my ($pkg,$retCode, $errMsg, $pkgInfo, $ptrReq, $reqPkg, $reqVer, 
			@reqAdd, $tgz, $path, $cmd, $sysRet, $ext, $cwd, $makeDir, $CPAN,
			$retValue );

	my $ret = 1;

	$cwd = getcwd();

	$wDir ||= &getCanonPath( dirname($0) );

	if ( $confixxState=~/conf|install/ ) {
		$CPAN = "$wDir/CPAN"; ## configure & install

	}	elsif (  $confixxState=~/update/  ||
			 ( $installDir && -d $installDir && -d "$installDir/admin/CPAN" ) ) {
		$CPAN = "$installDir/admin/CPAN";
	} else {
		$CPAN = "$wDir/CPAN"; ## configure & install
		unless ( -d $CPAN ){
			$CPAN = &getCanonPath( "$wDir/../CPAN" ); ## update
		}
	}

	$makeDir = "$wDir/install_packages";

	my $firstCall = $callCounter++?0:1;
	
	unless ( -d $makeDir ) {
		if ( $firstCall ) {
			mkdir $makeDir or
				die "Can't create work dir '$makeDir': $!\n";
			%preparedPkgs = ();
		} else {
			die "Work dir '$makeDir' is not found\n";
		}
	}

	unless( $bin_perl && -x $bin_perl ) {
		if ( $^X =~ /perl/ ) {
			$bin_perl = $^X;
		} else {
			$bin_perl = 'perl';
		}
	}

	$bin_tar ||= $bin{'tar'}||'tar';
	$bin_rm ||= $bin{'rm'} || 'rm'; 

	my $i=0;

	foreach  $pkg ( @toInstall ) {

		next if exists $preparedPkgs{$pkg};

		$i++;

		print "\n";
	  &header2( "Install package '$pkg' ..." );
		print "\n";

		$pkgInfo = $dbModules{$pkg};
		unless ( $pkgInfo ) {
			print STDERR "Error: Package '$pkg' is unknown\n";
			$preparedPkgs{$pkg} = undef;
			next;
		}

		if ( &checkPkgVersion( $pkg, $pkgInfo->[1] ) ) { ## package is already installed
		  print "Package '$pkg' is already installed (Ver. $pkgInfo->[1])\n\n";
			$preparedPkgs{$pkg} = 1;
		  next;
		}

#
# requirements
#
		$ptrReq = $pkgInfo->[2];
		if ( ref($ptrReq) =~ /HASH/ ) {
			@reqAdd = ();
			while ( ( $reqPkg, $reqVer ) = each %{$ptrReq} ) {

				next if $reqPkg eq $pkg; ## check loop
				
				if ( $reqPkg eq 'perl' ) {
#
# to do: check version of perl
#				
				  next;
				}

				unless ( &checkPkgVersion( $reqPkg, $reqVer )	) {
					push @reqAdd, $reqPkg;
				}
			}
			if ( @reqAdd ) {
				$ret = &installPkgs( @reqAdd );  ## !!! recursion !!!
				unless( $ret ){
					next; ## instalation failed
				}
			}
		}
#
# /requirements
#		

#
# uncompress source
#

		$tgz = $CPAN.'/'.$pkgInfo->[3];
		unless ( -f $tgz ) {
			foreach $ext ('.tar.gz','.tgz') {
				$path = $CPAN.'/'.$pkgInfo->[0].$ext;
				if ( -f $path ) {
					$tgz = $path;
					last;
				}
			}
		}

		unless( -f $tgz ) {
			print STDERR "Error: File '$path' is not found\n";
			next;
		}

		$cmd = "$bin_tar -xzf $tgz -C $makeDir";
		$sysRet = system( $cmd );
		if ( $sysRet != 0 ) {
			print STDERR "Error: Can't execute '$cmd': $!\n";
			next;
		}

		$path = $makeDir.'/'.$pkgInfo->[0];
		unless ( chdir( $path ) ) {
			print STDERR "Error: Can't change dir '$path': $!\n";
			next;
		}

#
# /uncompress source
#

#
# make & make install
#
		$sysRet = system( "$bin_perl Makefile.PL" );

		if ( $sysRet != 0 ){
			$sysRet >>= 8;			
			print STDERR "Error: Makefile.PL returned status $sysRet\n";
		} else {
			$sysRet = system( "make && make install UNINST=1" );
			if ( $sysRet != 0 ) {
				$sysRet >>= 8;							
				print STDERR "Error: make returned status $sysRet\n";
			}
		}

#
# /make & make install
#
		chdir( $cwd ) or
			warn "Can't chdir '$cwd': $!\n";
#
# clean source dir
#
		system( "$bin_rm -rf $path" );

#
# check result
#

		if ( $sysRet == 0 ) { ## OK
			$ret = 1;

		} else {
			$ret = 0;
			if ( $flatMode ){
				print &ltext('install_module_failed',$pkg);
				<STDIN>; ## press <return>
				$retValue = 1;

			} else {
				print STDERR &ltext('install_question_module_load', $pkg, $pkgInfo->[1]), "\n";
				unless ( $firstCall && ( $i == @toInstall ) ) {
					my $defaultAnswer =  &loadPackage( $pkg )? 'n': 'j';
					if ( &YesNoQuestion(  &ltext('install_question_module_next'), $defaultAnswer ) ) {
						$retValue = 0;
						last;
					} else {
						$retValue = 1;
					}
				}
			}
		}
		$preparedPkgs{$pkg} = $ret;

		if ( $ret ) { ## final check
			($retCode, $errMsg) = &checkPkgVersion( $pkg, $pkgInfo->[1], 'new' );
			if ( $retCode ) {
				print "\n";
				&header2("Package '$pkg' (Ver. $pkgInfo->[1]) is successfuly installed");
				print "\n";

			} else {
				if ( $errMsg ) {
					print STDERR "\n\nError: Package '$pkg' (Ver. $pkgInfo->[1]) is NOT installed\n$errMsg\n\n";
					$ret = 0;
				}
			}
		}
	}

#
# clean work dir
#
	if (  $firstCall ) { ## clean 
		system ( "$bin_rm -rf $makeDir" );
		$callCounter = 0;
		%preparedPkgs = ();

	} else {
  	  $callCounter--;
	}
	
	return $ret || $retValue;
}

1;

## /UNTERPROGRAMME
