package SisFile;

use Compress::Zlib;
use File::Basename;
use File::Path;
use File::Temp qw/ tempfile /;
use File::Spec;

sub New
	{
	my $invocant = shift;
	my $self = bless({}, ref $invocant || $invocant);
	
	$self->{sisfile} = shift;

	return unless $self->ReadSisFromFile($self->{sisfile});
	return $self;
	}

sub NewFromHandle
	{
	my $invocant = shift;
	my $self = bless({}, ref $invocant || $invocant);
	
	$self->{sisfile} = shift;
	my $handle = shift;

	return unless $self->ReadSis($handle);
	return $self;
	}

sub SisFileName
	{
	my $self = shift;
	return $self->{sisfile};
	}

sub AppName
	{
	my $self = shift;
	return $self->{applicationname}[$self->{defaultlanguage}];
	}

sub Uids
	{
	my $self = shift;
	return join(',', @{ $self->{uids} });
	}

my %LanguageHash = (
	1 => 'UK English',
	2 => 'French', 
	3 => 'German', 
	4 => 'Spanish', 
	5 => 'Italian', 
	6 => 'Swedish', 
	7 => 'Danish', 
	8 => 'Norwegian', 
	9 => 'Finnish', 
	10 => 'American', 
	11 => 'Swiss French', 
	12 => 'Swiss German', 
	13 => 'Portuguese', 
	14 => 'Turkish', 
	15 => 'Icelandic', 
	16 => 'Russian', 
	17 => 'Hungarian', 
	18 => 'Dutch', 
	19 => 'Belgian Flemish', 
	20 => 'Australian English', 
	21 => 'Belgian French', 
	22 => 'Austrian German', 
	23 => 'New Zealand English', 
	24 => 'International French', 
	25 => 'Czech', 
	26 => 'Slovak', 
	27 => 'Polish', 
	28 => 'Slovenian', 
	29 => 'Taiwanese Chinese', 
	30 => 'Hong Kong Chinese', 
	31 => 'PRC Chinese', 
	32 => 'Japanese', 
	33 => 'Thai', 
	34 => 'Afrikaans', 
	35 => 'Albanian', 
	36 => 'Amharic', 
	37 => 'Arabic', 
	38 => 'Armenian', 
	39 => 'Tagalog', 
	40 => 'Belarussian', 
	41 => 'Bengali', 
	42 => 'Bulgarian', 
	43 => 'Burmese', 
	44 => 'Catalan', 
	45 => 'Croation', 
	46 => 'Canadian English', 
	47 => 'International English', 
	48 => 'South African English', 
	49 => 'Estonian', 
	50 => 'Farsi', 
	51 => 'Canadian French', 
	52 => 'Gaelic', 
	53 => 'Georgian', 
	54 => 'Greek', 
	55 => 'Cyprus Greek', 
	56 => 'Gujarati', 
	57 => 'Hebrew', 
	58 => 'Hindi', 
	59 => 'Indonesian', 
	60 => 'Irish', 
	61 => 'Swiss Italian', 
	62 => 'Kannada', 
	63 => 'Kazakh', 
	64 => 'Kmer', 
	65 => 'Korean', 
	66 => 'Lao', 
	67 => 'Latvian', 
	68 => 'Lithuanian', 
	69 => 'Macedonian', 
	70 => 'Malay', 
	71 => 'Malayalam', 
	72 => 'Marathi', 
	73 => 'Moldovian', 
	74 => 'Mongolian', 
	75 => 'Norwegian Nynorsk', 
	76 => 'Brazilian Portuguese', 
	77 => 'Punjabi', 
	78 => 'Romanian', 
	79 => 'Serbian', 
	80 => 'Sinhalese', 
	81 => 'Somali', 
	82 => 'International Spanish', 
	83 => 'American Spanish', 
	84 => 'Swahili', 
	85 => 'Finland Swedish', 
	86 => 'Reserved', 
	87 => 'Tamil', 
	88 => 'Telugu', 
	89 => 'Tibetan', 
	90 => 'Tigrinya', 
	91 => 'Cyprus Turkish', 
	92 => 'Turkmen', 
	93 => 'Ukrainian', 
	94 => 'Urdu', 
	95 => 'Reserved', 
	96 => 'Vietnamese', 
	97 => 'Welsh', 
	98 => 'Zulu', 
	99 => 'Other',
	-1 => 'None' );

sub GetLanguageName
	{
	my $id = shift;
	my $name = $LanguageHash{$id};
	return $name ? $name : 'Unknown';
	}

sub Languages
	{
	my $self = shift;
	return join(',', @{ $self->{languages} });
	}

sub LanguageNames
	{
	my $self = shift;
	my @result;
	foreach ( @{ $self->{languages} } )
		{
		push @result, GetLanguageName($_);
		}
	return wantarray ? @result : join ', ', @result;
	}

sub LanguageUsed
	{
	my $self = shift;
	return $self->{languageused};
	}

sub FileCount
	{
	my $self = shift;
	return $self->{packagelines};
	}

sub DependencyCount
	{
	my $self = shift;
	return $self->{dependencycount};
	}

sub FilesInstalled
	{
	my $self = shift;
	return $self->{filesinstalled};
	}

sub InstallDrive
	{
	my $self = shift;
	return $self->{installdrive};
	}

sub InstallerVersion
	{
	my $self = shift;
	return $self->{installversion};
	}

my %FlagHash = (
	0 => 'EInstIsUnicode',
	1 => 'EInstIsDistributable',
	2 => 'EInstIsCompareToMajor',
	3 => 'EInstNoCompress',
	4 => 'EInstShutdownApps' );

sub FlagNames
	{
	my $self = shift;
	my @result;
	foreach ( keys %FlagHash )
		{
		my $shift = 1 << $_;
		push @result, $FlagHash{$_} if $self->{flags} & $shift;
		}
	return wantarray ? @result : join ', ', @result;
	}

sub Flags
	{
	my $self = shift;
	return $self->{flags};
	}

my %TypeHash = (
	0 => 'EInstSISApp',
	1 => 'EInstSISSystem',
	2 => 'EInstSISOption',
	3 => 'EInstSISConfig',
	4 => 'EInstSISPatch',
	5 => 'EInstSISUpgrade',
	6 => 'EInstMIDletSuite',
	7 => 'EInstMIDlet',
	9 => 'EBin' );

sub TypeName
	{
	my $self = shift;
	return $TypeHash{$self->{type}};
	}

sub Type
	{
	my $self = shift;
	return $self->{type};
	}

sub Version
	{
	my $self = shift; 
	return "$self->{version}[0].$self->{version}[1]($self->{version}[2])";
	}

sub SpaceUsed
	{
	my $self = shift;
	return $self->{type};
	}

sub MaxInstallSize
	{
	my $self = shift;
	return $self->{maxinstallsize};
	}

sub AreFilesCompressed
	{
	my $self = shift;
	return !($self->Flags() & 0x8);
	}

sub Files
	{
	my $self = shift;
	my @files;
	foreach my $pkg ( @{ $self->{packages} } )
		{
		if ($pkg->{destination} && ($pkg->{packagetype} == 0 || $pkg->{packagetype} == 1))
			{
			push @files, lc $pkg->{destination};
			}
		elsif ($pkg->{source})
			{
			push @files, $pkg->{source};
			}
		}
	return @files;
	}

my %FileTypeHash = (
	0 => 'EInstFileTypeSimple',
	1 => 'EInstFileTypeText',
	2 => 'EInstFileTypeComponent',
	3 => 'EInstFileTypeRun',
	4 => 'EInstFileTypeNull',
	5 => 'EInstFileTypeMime',
	6 => 'EInstFileTypeSubSIS',
	7 => 'EInstFileTypeContainerSIS',
	8 => 'EInstFileTypeTextUninstall',
	99 => 'EInstFileTypeNotInstalled' );

sub FileTypeName
	{
	my $self = shift;
	my $filename = shift;
	my $type = $self->FileType($filename);
	return $FileTypeHash{$type};
	}

sub FileType
	{
	my $self = shift;
	my $filename = shift;
	my $pkg = $self->getPkgByFilename($filename);
	return $pkg->{type};
	}

sub FileOptions
	{
	my $self = shift;
	my $filename = shift;
	my $pkg = $self->getPkgByFilename($filename);
	return $pkg->{options};
	}

sub OriginalSize
	{
	my $self = shift;
	my $filename = shift;
	my $pkg = $self->getPkgByFilename($filename);

	my $language = $self->{defaultlanguage};
	$language = 0 unless defined($pkg->{file}{orig}[$self->{defaultlanguage}]);
	return $pkg->{file}{orig}[$language];
	}

sub Size
	{
	my $self = shift;
	my $filename = shift;
	my $pkg = $self->getPkgByFilename($filename);

	my $language = $self->{defaultlanguage};
	$language = 0 unless defined($pkg->{file}{len}[$self->{defaultlanguage}]);
	return $pkg->{file}{len}[$language];
	}

sub ExtractFile
	{
	my $self = shift;
	my $filename = shift;
	my $outfh = shift;

	my $pkg = $self->getPkgByFilename($filename);
	die "No such package: $filename" unless $pkg;

	open INFILE, $self->{sisfile} or die "Unable to open file: $!";
	binmode INFILE;
	my $language = $self->{defaultlanguage};
	$language = 0 unless defined($pkg->{file}{ptr}[$self->{defaultlanguage}]);
	printBinaryViaPtr(\*INFILE, $outfh, $pkg->{file}{ptr}[$language], $pkg->{file}{len}[$language], $self->AreFilesCompressed());
	close INFILE;
	}

sub ExtractSis
	{
	my $self = shift;
	my $path = shift;

	foreach my $filename ( sort $self->Files() )
		{
		# Ignore zero length file - is this a directory?
		next if $self->Size($filename) == 0;

		my $destination = $filename;
		$destination =~ s/.:\\//o;
		$destination =~ s/\\/\//g;
		$destination = File::Spec->catfile($path,$destination);

		#print "Extracting: $filename\n";
		#print "Destination: $destination\n";
		unlink dirname $destination; # eh?
		mkpath dirname $destination;

		next if -d $destination;
		open OUTFILE, ">$destination" or die "Failed to create file $destination: $!";
		binmode OUTFILE;
		$self->ExtractFile($filename, \*OUTFILE);
		close OUTFILE;

		# Decompress can fail on corrupted files?
		next if -s $destination == 0; # bug?

		# Install sub-SIS files
		my $type = $self->FileType($filename);
		if ($type == 2 || $type == 6 || $type == 7 && $filename =~ /\.sis$/oi)
			{
			my $sisfile = SisFile->New($destination);
			next unless $sisfile;

			$sisfile->ExtractSis($path);
			unlink $destination;
			}
		}	
	}

sub DependencyFiles
	{
	my $self = shift;
	my @deps;
	foreach my $dep ( @{ $self->{dependencies} } )
		{
		push @deps, $dep->{name}[$self->{defaultlanguage}];
		}
	return @deps;
	}

sub getPkgByFilename
	{
	my $self = shift;
	my $filename = shift;
	foreach my $pkg ( @{ $self->{packages} } )
		{
		return $pkg if $pkg->{destination} eq $filename;
		return $pkg if $pkg->{source} eq $filename;
		}
	}

sub ReadSisFromFile
	{
	my $self = shift;
	my $filename = shift;
	open INPUT, $filename or die "Unable to open $filename: $!";
	my $result = $self->ReadSis(\*INPUT);
	close INPUT;
	return $result;
	}

sub ReadSis
	{
	my $self = shift;
	my $fh = shift;

	binmode $fh;

	# Uids
	push @{ $self->{uids} }, sprintf '%x', getLong($fh);
	push @{ $self->{uids} }, sprintf '%x', getLong($fh);
	push @{ $self->{uids} }, sprintf '%x', getLong($fh);

	# Uid checksum
	getLong($fh);

	# Sis file checksum
	getShort($fh);

	# Language count
	$self->{languagecount} = getShort($fh);

	# File count
	$self->{packagelines} = getShort($fh);

	# Number of dependencies
	$self->{dependencycount} = getShort($fh);

	# Language used
	$self->{languageused} = getShort($fh);

	# Number of files already installed
	$self->{filesinstalled} = getShort($fh);

	# Install drive
	$self->{installdrive} = chr getShort($fh);

	# Number of capabilities
	$self->{capabilitycount} = getShort($fh);

	# Installer version
	$self->{installversion} = getLong($fh);

	# Can't read any other SIS file versions yet
	if ($self->{installversion} != 200)
		{
		print STDERR "Can't read SIS file version: $self->{installversion}\n";
		return;
		}

	# Flags
	$self->{flags} = getShort($fh);

	# Type
	$self->{type} = getShort($fh);

	# Version
	push @{ $self->{version} }, getShort($fh);
	push @{ $self->{version} }, getShort($fh);
	push @{ $self->{version} }, getLong($fh);

	# Languages offset
	$self->{languageoffset} = getLong($fh);

	# Package files offset
	$self->{packageoffset} = getLong($fh);

	# Dependencies offset
	$self->{dependencyoffset} = getLong($fh);

	# Certificates offset
	$self->{certificateoffset} = getLong($fh);

	# App names offset
	$self->{appnamesoffset} = getLong($fh);

	# Signiture offset
	$self->{signatureoffset} = getLong($fh);

	# Capabilities offset
	$self->{capabilitiesoffset} = getLong($fh);

	# Space used
	$self->{spaceused} = getLong($fh);

	# Max install size
	$self->{maxinstallsize} = getLong($fh);

	# Languages
	seek $fh, $self->{languageoffset}, 0;
	$self->{defaultlanguage} = 0;
	for(my $count = 0; $count < $self->{languagecount}; $count++)
		{
		my $code = getShort($fh);
		push @{ $self->{languages} }, $code;
		$self->{defaultlanguage} = int(scalar(@{ $self->{languages} }) - 1) if $code == 1;
		}

	# Packages
	seek $fh, $self->{packageoffset}, 0;
	for(my $count = 0; $count < $self->{packagelines}; $count++)
		{
		my %pkgdata;

		# Package Type
		$pkgdata{packagetype} = getLong($fh);

		if ($pkgdata{packagetype} == 0 || $pkgdata{packagetype} == 1)
			{
			# File type
			$pkgdata{type} = getLong($fh);

			# File options
			$pkgdata{options} = getLong($fh);

			# Source filename length
			my $length = getLong($fh);
		
			# Source filename pointer
			my $ptr = getLong($fh);

			# Source filename
			$pkgdata{source} = lc getStringViaPtr($fh, $ptr, $length);
			$pkgdata{source} =~ s#^.*[\\/]([^\\/]+)$#$1#o;

			# Destination filename length
			$length = getLong($fh);

			# Destination filename pointer
			$ptr = getLong($fh);

			# Destination filename
			$pkgdata{destination} = lc getStringViaPtr($fh, $ptr, $length);
		
			# Multiple language versions
			my $languageCount = $pkgdata{packagetype} == 0 ? 1 : $self->{languagecount};

			# Length of file data
			for(my $count = 0; $count < $languageCount; $count++)
				{
				push @{ $pkgdata{file}{len} }, getLong($fh);
				}

			# Pointer to file data
			for(my $count = 0; $count < $languageCount; $count++)
				{
				push @{ $pkgdata{file}{ptr} }, getLong($fh);
				}

			# Original size of file data
			for(my $count = 0; $count < $languageCount; $count++)
				{
				push @{ $pkgdata{file}{orig} }, getLong($fh);
				}

			# Unknown
			getLong($fh);
			
			# End of names pointer	
			getLong($fh);

			# Add package data
			push @{ $self->{packages} }, \%pkgdata;
			}
		# EInstPkgLineCondElse or EInstPkgLineCondEndIf
		elsif ($pkgdata{packagetype} == 5 || $pkgdata{packagetype} == 6)
			{
			# Do nothing
			}
		# EInstPkgLineCondIf or EInstPkgLineCondElseIf
		elsif ($pkgdata{packagetype} == 3 || $pkgdata{packagetype} == 4)
			{
			my $size = getLong($fh);
			seek $fh, $size, 1;
			}
		elsif ($pkgdata{packagetype} == 2)
			{
			# Number of options
			my $options = getLong($fh);

			# Advance past end of strings
			seek $fh, $options * $self->{languagecount} * 4 * 2, 1;

			# Advance past end of selected options
			seek $fh, 4 * 4, 1;
			}
		else
			{
			die "Unknown package type: $pkgdata{packagetype}";
			}
		}

	# Dependencies
	seek $fh, $self->{dependencyoffset}, 0;
	for(my $count = 0; $count < $self->{dependencycount}; $count++)
		{
		my %depdata;

		# Uid
		$depdata{uid} = sprintf '%x', getLong($fh);

		# Version
		push @{ $depdata{version} }, getShort($fh);
		push @{ $depdata{version} }, getShort($fh);
		push @{ $depdata{version} }, getLong($fh);

		# dependency name length
		my %data;
		for(my $count = 0; $count < $self->{languagecount}; $count++)
			{
			$data{$count}{len} = getLong($fh);
			}

		# dependency name pointer
		for(my $count = 0; $count < $self->{languagecount}; $count++)
			{
			$data{$count}{ptr} = getLong($fh);
			}

		# Dependency names
		for(my $count = 0; $count < $self->{languagecount}; $count++)
			{
			push @{ $depdata{name} }, getStringViaPtr($fh, $data{$count}{ptr}, $data{$count}{len});
			}

		# Add dependency data
		push @{ $self->{dependencies} }, \%depdata;
		}

	# Application Names
	my %data;
	seek $fh, $self->{appnamesoffset}, 0;
	for(my $count = 0; $count < $self->{languagecount}; $count++)
		{
		$data{$count}{len} = getLong($fh);
		}
	for(my $count = 0; $count < $self->{languagecount}; $count++)
		{
		$data{$count}{ptr} = getLong($fh);
		}
	for(my $count = 0; $count < $self->{languagecount}; $count++)
		{
		push @{ $self->{applicationname} }, getStringViaPtr($fh, $data{$count}{ptr}, $data{$count}{len});
		}
	return 1;
	}

sub Dump
	{
	my $self = shift;
	my $embed = shift;

	# Sis file details

	print "Sis File: ", $self->SisFileName(), "\n";
	print "App Name: ", $self->AppName(), "\n"; 
	print "Uids: ", $self->Uids(), "\n"; 
	print "Languages: ", scalar $self->LanguageNames(), "\n"; 
	print "Language Used: ", $self->LanguageUsed(), "\n"; 
	print "File Count: ", $self->FileCount(), "\n"; 
	print "Files Installed: ", $self->FilesInstalled(), "\n"; 
	print "Dependency Count: ", $self->DependencyCount(), "\n"; 
	print "Install Drive: ", $self->InstallDrive(), "\n"; 
	print "Install Version: ", $self->InstallerVersion(), "\n"; 
	print "Flags: ", scalar $self->FlagNames(), "\n"; 
	print "Type: ", $self->TypeName(), "\n"; 
	print "Version: ", $self->Version(), "\n"; 
	print "Max Install Size: ", $self->MaxInstallSize(), "\n"; 

	# List of files
	my @sisfiles = $self;
	foreach my $sisfile ( @sisfiles )
		{
		my @files = $sisfile->Files();
		foreach my $filename ( @files )
			{
			my $type = $sisfile->FileType($filename);
			if ($embed && ($type == 2 || $type == 6 || $type == 7) && $filename =~ /\.sis$/oi)
				{
				my ($fh, $tempfilename) = tempfile(UNLINK => 1);

				open OUTFILE, ">$tempfilename" or die "Failed to create file $filename: $!";
				binmode OUTFILE;
				$sisfile->ExtractFile($filename, \*OUTFILE);
				close OUTFILE;

				my $embedsisfile = SisFile->New($tempfilename);
				push @sisfiles, $embedsisfile;
				next;
				}

			print "File: $filename\n";
			print "\tCompressedSize: ", $sisfile->Size($filename), "\n";
			print "\tUncompressed Size: ", $sisfile->OriginalSize($filename), "\n";
			print "\tOptions: ", sprintf('0x%x', $sisfile->FileOptions($filename)), "\n";
			print "\tType: ", $sisfile->FileTypeName($filename), "\n";
			}
		}

	# List of dependencies
	print "Dependencies: ", join(', ', $self->DependencyFiles()), "\n";
	}

# Does not advance the file handle
sub printBinaryViaPtr
	{
	my $fh = shift;
	my $out = shift;
	my $ptr = shift;
	my $length = shift;
	my $uncompress = shift;

	return if $length == 0;
	my $old = tell $fh;
	my $data;
	seek $fh, $ptr, 0;
	read $fh, $data, $length or die "cant read data of length $length from file at $ptr: $!";
	seek $fh, $old, 0;

	if ($uncompress)
		{
		my $result = uncompress($data);
		#die "Failed to decmpress data" unless $result;
		print $out $result;
		}
	else
		{
		print $out $data;
		}
	}

# Does not advance the file handle
sub getStringViaPtr
	{
	my $fh = shift;
	my $ptr = shift;
	my $length = shift;
	return if $length == 0;

	my $old = tell $fh;
	seek $fh, $ptr, 0;
	
	my $data;
	while($length > 0)
		{
		my $wchar;
		last unless read($fh, $wchar, 2) == 2;
		my $code = unpack "v", $wchar;
		$data .= chr($code) if $code >=32 && $code <= 255;
		$length-=2;
		}

	seek $fh, $old, 0;
	return $data;

#	read $fh, $data, $length or die "cant read data $length bytes from file at $ptr: $!";
#	my $uni = Unicode::String::utf16($data);
#	$uni->byteswap;
#	return $uni->utf8;
	}

# Advances the file handle
sub getLong
	{
	my $fh = shift;

	my $data;
	my $pos = tell $fh;
	read $fh, $data, 4 or die "cant read data from file at $pos: $!";
	
	return unpack 'l', $data;
	}

# Advances the file handle
sub getShort
	{
	my $fh = shift;

	my $data;
	read $fh, $data, 2 or die "cant read data from file: $!";
	
	return unpack 's', $data;
	}

1;