#!/usr/bin/perl -w

use strict;
use Cwd 'abs_path';
use File::Basename;
use File::Fetch;
use File::Find;
use File::Temp;
use Archive::Tar;
use File::Path qw(make_path rmtree);
use JSON::PP;
use version;
use LWP::UserAgent;
use Digest::SHA;
use Digest::MD5;

my $cmd = shift;

my $user_dir = get_user_dir();
make_path ($user_dir);

my $packages_dir = $user_dir."/packages/";
make_path ($packages_dir);

my $info_dir = $user_dir."/info/";
make_path ($info_dir);

if (!defined($cmd))
{
    &show_help();
    exit(1);
}
elsif ($cmd eq "help" or $cmd eq "--help" or $cmd eq "-h")
{
    &show_help();
    exit(0);
}
elsif ($cmd eq "install-archive")
{
    install_archive(@ARGV);
}
elsif ($cmd eq "install")
{
    install_package(@ARGV);
}
elsif ($cmd eq "uninstall")
{
    uninstall_package(@ARGV);
}
elsif ($cmd eq "info")
{
    show_package_info(@ARGV);
}
elsif ($cmd eq "files")
{
    list_files_for_package(@ARGV);
}
elsif ($cmd eq "packages")
{
    list_installed_packages();
}
elsif ($cmd eq "untracked")
{
    list_untracked_files();
}
elsif ($cmd eq "missing")
{
    list_missing_files();
}
elsif ($cmd eq "installed")
{
    list_installed_files();
}
elsif ($cmd eq "available")
{
    &list_available_packages();
}
elsif ($cmd eq "help")
{
    &show_help();
    exit(0);
}
else
{
    print STDERR "Error: I don't understand command '$cmd'.\n\n";
    &show_help();
    exit(1);
}


sub get_user_dir
{
    my $home = $ENV{"HOME"};
    error_exit("Home directory unset or does not exist!") if (! -d $home);
    
    my $user_dir = $home."/.local/share/bali-phy/";
    return $user_dir;
}

# update to use JSON
sub get_package_info
{
    my $filename = shift;
    my $tar = Archive::Tar->new($filename);
    my $data = $tar->get_content("control.json");
    my $control = decode_json($data);
    return $control;
}

sub files_for_archive
{
    my $archive = shift;
    my @filenames = ();
    my $tar = Archive::Tar->new($archive);
    for my $filename ($tar->list_files)
    {
	if ($filename =~ s|^files/||)
	{
	    my $new_name = $packages_dir."/".$filename;

	    next if ($filename eq "");
	    if ($filename !~ m|/$|)
	    {
		push @filenames, $filename;
	    }
	}
    }
    return @filenames;
}

sub check_overwrite
{
    my $archive = shift;
    my $ignore_pkg = shift;
    my @files = files_for_archive($archive);

    for my $pkg (installed_packages())
    {
	next if (defined($ignore_pkg) && ($pkg eq $ignore_pkg));
	my @pkg_files_ = installed_files_for_package($pkg);
	my %pkg_files = map { $_ => 1 } @pkg_files_;
	for my $file (@files)
	{
	    if (exists($pkg_files{$file})) 
	    {
		error_exit("install: Package '$pkg' contains conflicting file '$file'.\nAborting installation.");
	    }
	}
    }

    my %untracked = map {$_ => 1} untracked_files();
    for my $filename (@files)
    {
	if (exists($untracked{$filename})) 
	{
	    error_exit("install: Refusing to overwrite untracked file \"$filename\".\nAborting installation.");
	}
    }
}

# put installed files BOTH in a separate dir, AND in a combined dir?
sub install_archive
{
    my $archive = shift;
    if (!defined($archive))
    {
	error_exit("install: no package name given.");
    }
    my $package_info = get_package_info($archive);
    my $name = ${$package_info}{"Package"};
    my $version = ${$package_info}{"Version"};

    if (! -e $archive)
    {
	error_exit("install: archive \"$archive\" not found!\nAborting installation.");
    }

    #1. Handle installed versions
    if (is_package_broken($name))
    {
	error_exit("install: Package $name is in a broken state. Try uninstalling first.");
    }
    
    if (!is_same_or_newer_version($name,$version))
    {
	my $installed_version = get_package_version($name);
	error_exit("install: Version $version not the same or newer than installed version $installed_version.\nAborting installation.");
    }

    check_overwrite($archive,$name);
    
    uninstall_package($name) if (is_package_installed($name));

    print "Installing $name version $version ... ";
    my $tar = Archive::Tar->new($archive);
    my $package_info_dir = $info_dir."/$name/";
    make_path($package_info_dir);
    $tar->extract_file("control.json",$package_info_dir."/control.json");
    open(FILES,">",$package_info_dir."/Files");

    for my $filename (files_for_archive($archive))
    {
	my $new_name = $packages_dir."/".$filename;
	print FILES "$filename\n";
	$tar->extract_file("files/".$filename,$new_name);
    }
    close(FILES);
    print "done.\n";
}

sub all_files_removed
{
    my $name = shift;
    my @files1 =  read_file_lines($info_dir."/$name/Files");
    my %files1_ = map {$_ => 1} @files1;
    my @files2 =  read_file_lines($info_dir."/$name/Files");
    my %files2_ = map {$_ => 1} @files2;

    my $n1 = scalar(@files1);
    my $n2 = scalar(@files2);
    return 0 if ($n2 < $n1);
    die "Remove $n2 files out of $n1.  How could that happen?\n" if ($n1 > $n2);

    foreach my $file1 (@files1)
    {
	return 0 if (!exists($files2_{$file1}));
    }

    return 1;
}

sub uninstall_package
{
    my $name = shift;
    if (!defined($name))
    {
	error_exit("uninstall: No package name given.");
    }
    if (!is_package_installed($name))
    {
	error_exit("uninstall: Package $name is not installed.");
    }
    if (-e "$info_dir/$name/Files")
    {
	my $installed_version = get_package_version($name);
	print "Uninstalling $name version $installed_version ... ";
	open(FILES,"$info_dir/$name/Files");
	open(RM,">>","$info_dir/$name/FilesRemoved");
	while(my $file = <FILES>)
	{
	    chomp $file;
	    my $filename = $packages_dir."/".$file;
	    if (! -e $filename)
	    {
	    }
	    elsif (unlink $filename)
	    {
		print RM "$file\n";
	    }
	    else
	    {
		warn "Could not unlink $filename: $!";
	    }
	}
	close RM;
	close FILES;
    }
    if (all_files_removed($name))
    {
	rmtree("$info_dir/$name/");
	print "done.\n";
    }
    else
    {
	print STDERR "Failed to uninstall $name!\n";
	exit(1);
    }
}

sub installed_packages
{
    my @packages = ();
    opendir(DIR, $info_dir) or die $!;
    while (my $file = readdir(DIR))
    {
	next if ($file eq ".");
	next if ($file eq "..");
	push @packages, $file;
    }
    close DIR;
    return @packages;
}

sub list_installed_packages
{
    my @packages = installed_packages();
    for my $pkg (@packages)
    {
	my $version = "broken";
	if (!is_package_broken($pkg))
	{
	    $version = get_package_version($pkg);
	}
	print "$pkg $version\n";
    }
    print "No packages installed.\n" if (!@packages);
}

sub read_JSON_file
{
    my $filename = shift;

    my $json;
    {
	local $/; # Enable 'slurp' mode
	open my $fh, "<", $filename or error_exit("Can't open \"$filename\": $!");
	$json = <$fh>;
	close $fh;
    };
    
    return decode_json($json);
}

sub write_JSON_file
{
    my $data = shift;
    my $filename = shift;
    open my $fh, ">", $filename;
    print $fh encode_json($data);
    close $fh;
}

sub read_installed_package_info
{
    my $name = shift;
    
    return read_JSON_file($info_dir."/$name/control.json");
}

sub write_installed_package_info
{
    my $name = shift;
    my $data = shift;
    return write_JSON_file($data, $info_dir."/$name/control.json");
}

sub show_package_info
{
    my $pkg = shift;
    if (!defined($pkg))
    {
	error_exit("info: No package name given.");
    }
    my $info = read_installed_package_info($pkg);
    for my $field (keys(%$info))
    {
	my $value = ${$info}{$field};
	print "$field: $value\n";
    }
}

sub installed_files
{
    my @files = ();
    for my $pkg (installed_packages())
    {
	@files = (@files,installed_files_for_package($pkg));
    }
    return @files;}

sub is_package_installed
{
    my $name = shift;
    my $dirname = $info_dir."/$name/";
    return 1 if (-d $dirname);
    return 0;
}

sub is_package_broken
{
    my $name = shift;
    my $dirname = $info_dir."/$name/";
    if (-d $dirname) 
    {
	return 1 if (! -e $dirname."/control.json");
	return 1 if (! -e $dirname."/Files");
	return 1 if ( -e $dirname."/FilesRemoved");
    }
    return 0;
}

sub get_package_version
{
    my $name = shift;
    
    my $pkg = read_installed_package_info($name);
    return ${$pkg}{"Version"};
}

sub read_file_lines
{
    my $filename = shift;

    open my $fh,"<",$filename;

    my @lines = ();
    for my $line (<$fh>)
    {
	chomp $line;
	push @lines, $line;
    }
    return @lines;
}

# change to storing info/package.files, info/package.info
sub installed_files_for_package
{
    my $name = shift;

    return read_file_lines($info_dir."/$name/Files");
}

sub list_files_for_package
{
    my $name = shift;

    if (!defined($name))
    {
	error_exit("files: No package name given.");
    }

    if (!is_package_installed($name))
    {
	error_exit("files: No package named \"$name\" is currently installed.");
    }
    
    for my $filename (installed_files_for_package($name))
    {
	print "$filename\n";
    }
}

sub list_installed_files
{
    my $name = shift;
    for my $filename (installed_files())
    {
	print "$filename\n";
    }
}

sub present_files
{
    my @files;
    
    find(sub {if (! -d $File::Find::name) {push @files, $File::Find::name}},$packages_dir);
    foreach my $file (@files)
    {
	$file =~ s/^$packages_dir//;
    }
    return @files;
}

sub untracked_files
{
    my %files = map { $_ => 1 } installed_files();
    
    my @untracked = ();
    foreach my $file (present_files())
    {
	push @untracked, $file if (!exists($files{$file}));
    }
    return @untracked;
}

sub list_untracked_files
{
    foreach my $file (untracked_files())
    {
	print "$file\n";
    }
}

sub missing_files
{
    my %present = map { $_ => 1 } present_files();
    
    my @missing = ();
    foreach my $file (installed_files())
    {
	push @missing, $file if (!exists($present{$file}));
    }
    return @missing;
}

sub list_missing_files
{
    foreach my $file (missing_files())
    {
	print "$file\n";
    }
}

sub show_help()
{
    print "Usage: bali-phy-pkg <command> [arg]\n";
    print "Commands are: install, install-archive, available, uninstall, info, packages, files, untracked, missing, installed, help\n";
}

sub error_exit
{
    my $msg = shift;
    print "Error: $msg\n";
    exit(1);
}

sub remote_packages_info()
{
#   HTTPS isn't part of the PERL core.
#    my $uri = 'https://raw.githubusercontent.com/bredelings/bali-phy-packages/master/Packages';
    my $uri = 'http://www.bali-phy.org/packages/Packages';
    my $ua = LWP::UserAgent->new( ssl_opts => {verify_hostname => 0} );
    my $response = $ua->get($uri);

    error_exit($response->status_line) if (!$response->is_success);

    my $data = $response->decoded_content;

    my $packages = decode_json($data);
    return $packages;
}

sub remote_package_info
{
    my $name = shift;
    my $packages = remote_packages_info();
    for my $pkg (@$packages)
    {
	return $pkg if (${$pkg}{"Package"} eq $name);
    }
    return undef;
}

sub list_available_packages()
{
    my $packages = remote_packages_info();
    for my $pkg (@$packages)
    {
	my $name = ${$pkg}{"Package"};
	my $version = ${$pkg}{"Version"};
	my $source = ${$pkg}{"Source"};
	my $filename = "${name}_${version}.tar.gz";
	my $url = "$source/$filename";
	print "$name\t$version\t$url\n";
    }
}

sub is_new_version
{
    my $name = shift;
    my $version = shift;
    return 1 if (!is_package_installed($name));

    my $installed_version = get_package_version($name);
    return (version->declare("v".$version) > version->declare("v".$installed_version));
}

sub is_same_or_newer_version
{
    my $name = shift;
    my $version = shift;
    return 1 if (!is_package_installed($name));

    my $installed_version = get_package_version($name);
    return (version->declare("v".$version) >= version->declare("v".$installed_version));
}


sub install_package
{
    my $name = shift;
    print "Fetching package list ... ";
    my $pkg = remote_package_info($name);
    print "done.\n";
    error_exit("Package '$name' not found!") if (!defined($pkg));

    my $version = ${$pkg}{"Version"};
    my $source  = ${$pkg}{"Source"};
    my $filename = "${name}_${version}.tar.gz";
    my $url = "$source/$filename";

    if (!is_new_version($name,$version))
    {
	error_exit("install: Remote Version $version not newer than installed version $version.\nAborting installation.");
    }

    print "Downloading package for $name version $version ... ";
    my $fetcher = File::Fetch->new(uri => "$url");
    my $data;
    my $where = $fetcher->fetch( to => \$data );
    print "done.\n";

    error_exit("Package has wrong SHA1!") if (${$pkg}{"SHA1"} ne shasum(1,$where));
    error_exit("Package has wrong SHA256!") if (${$pkg}{"SHA256"} ne shasum(256,$where));
    error_exit("Package has wrong MD5sum!") if (${$pkg}{"MD5sum"} ne md5sum($where));
    
    install_archive($where);
}

sub shasum
{
    my $arg = shift;
    my $filename = shift;
    my $fh;
    unless (open $fh,$filename) {
	print STDERR "$0: open $filename: $!";
	exit(1);
    }

    my $sha1 = Digest::SHA->new($arg);
    $sha1->addfile($fh);
    my $digest = $sha1->hexdigest;
    close $fh;
    return $digest;
}
    
sub md5sum
{
    my $filename = shift;
    my $fh;
    unless (open $fh,$filename) {
	print STDERR "$0: open $filename: $!";
	exit(1);
    }

    my $md5 = Digest::MD5->new();
    $md5->addfile($fh);
    my $digest = $md5->hexdigest;
    close $fh;
    return $digest;
}