#!/usr/bin/perl

use FindBin;
use lib "$FindBin::Bin/../../../perl_lib";

=pod

=for Pod2Wiki

=head1 NAME

epm - EPrints Package Manager

=head1 SYNOPSIS

epm I<command> [B<options>]

Where I<command> is one of:

	build
	check_config
	check_symlinks
	disable
	enable
	install
	link_lib
	list
	rebuild
	uninstall
	unlink_lib
	unpack

=head1 OPTIONS

=over 4

=item --verbose

=item --force

=item --retain

Retain the datasets/fields and counters for the EPM even if it is configured not to retain them.  Only used by disable.

=item --help

=item --man

=item --epm L<package_path>

Read metadata from the epm at L<package_path> when building.

=item --version

Set the version when building.

=item --to-link

Unpack in such as way it can the epm can be install with link_lib

=back

=head1 COMMANDS

=over 4

=cut

use EPrints;
use File::Slurp;
use Getopt::Long;
use Pod::Usage;
use Digest::MD5;
use MIME::Base64;
use Cwd;

use strict;
use warnings;

my $opt_version;
my $opt_verbose = 0;
my $opt_force = 0;
my $opt_retain = 0;
my $opt_to_link = 0;
my $opt_help;
my $opt_man;
my $opt_epm;

GetOptions(
	'epm=s' => \$opt_epm,
	'version=s' => \$opt_version,
	'verbose+' => \$opt_verbose,
	'force' => \$opt_force,
	'retain' => \$opt_retain,
	'to-link' => \$opt_to_link,
	'help' => \$opt_help,
	'man' => \$opt_man,
) or pod2usage( 2 );

pod2usage(-verbose => 1) if $opt_help;
pod2usage(-verbose => 2) if $opt_man;

pod2usage( 2 ) if !@ARGV;

my $cmd = shift @ARGV;

my $noise = $opt_verbose + 1;
my $force = $opt_force;
my $broken_symlinks = 0;
my $f = "action_$cmd";
if( !defined &$f )
{
	pod2usage( "Unknown or unsupported command '$cmd'" );
}
if ( $f eq "action_check_symlinks" )
{
	no strict "refs";
	&$f();
	print "\n$broken_symlinks broken symlinks found\n";
	print "Use --force to delete broken symlinks\n" if ! $force && $broken_symlinks;
	exit;
}

my @_repoids = EPrints::Config::get_repository_ids();
my $_repoid = scalar(@_repoids) ? $_repoids[0] : undef;
my $repo = EPrints::Repository->new( $_repoid ); # need any valid repo
#my $repo = EPrints::Repository->new;
my $handler = EPrints::CLIProcessor->new(
	repository => $repo,
);
my $dataset = $repo->dataset( "epm" );

{
no strict "refs";
&$f( $repo );
}

sub repository
{
	my( $repoid ) = @_;
	return $repoid if UNIVERSAL::isa( $repoid, "EPrints::Repository" );
	my $repo = EPrints->repository( $repoid );
	if( !defined $repo )
	{
		die "'$repoid' is not a valid repository identifier";
	}
	return $repo;
}

sub epm
{
	my( $repo, $name ) = @_;

	my $epm = $repo->dataset( 'epm' )->dataobj( $name );
	if( !defined $epm )
	{
		$handler->add_message( "error", $repo->xml->create_text_node(
			"'$name' is not installed or is an invalid epm identifier"
		) );
		exit(1);
	}
	return $epm;
}

=item build I<package> I<file1> I<file2> ...

Build a new package called C<package> from a list of files.

	./epm build endnote \
		lib/plugins/EPrints/Plugin/Export/EndNote.pm \
		lib/epm/endnote.pl

Where C<lib/epm/endnote.pl> contains:

	$c->{plugins}{"Export::EndNote"}{params}{disable} = 0;

=cut

sub action_build
{
	my( $repo ) = @_;

	pod2usage( 2 ) if @ARGV < 2;
	my( $name, @manifest ) = @ARGV;

	my $epdata = {};
	if( $opt_epm )
	{
		if(open(my $fh, "<", $opt_epm))
		{
			sysread($fh, my $xml, -s $fh);
			close($fh);
			my $epm = $dataset->dataobj_class->new_from_xml( $repo, $xml );
			$epdata = $epm->get_data;
		}
		else
		{
			die "Error reading from $opt_epm: $!";
		}
	}
	# sanity check they aren't bundling "installed" epms
	if( my @bad = grep { $_ =~ m# ^lib/epm/[^/]+\.epmi?$ #x } @manifest )
	{
		die "Can not bundle installed package files: @bad";
	}

	delete $epdata->{documents};
	$epdata->{epmid} = $name;
	$epdata->{datestamp} = EPrints::Time::iso_datetime();
	$epdata->{version} = $opt_version if $opt_version;
	$epdata->{version} = '1.0.0'
		if !EPrints::Utils::is_set( $epdata->{version} );

	my $pkg_cache = $repo->config( "base_path" ) . "/var/cache/epm";
	EPrints->system->mkdir( $pkg_cache )
		or die "Error creating directory $pkg_cache: $!";

	my $epm = $dataset->dataobj_class->new_from_manifest(
		$repo, $epdata, @manifest
	);

	my $output = sprintf("%s/%s-%s.epm",
		$pkg_cache,
		$epm->value( "epmid" ),
		$epm->value( "version" )
	);

	open(my $fhout, ">", $output) or die "Error writing to $output: $!";

	binmode($fhout, ":utf8");
	$epm->serialise( $fhout, 1 );

	print "$output\n";
}

=item check_config I<repository> I<package>

Checks the archive-specific configuration files for I<package> against
those already present in I<repository> archive

=cut

sub action_check_config
{
    pod2usage() if @ARGV != 2;
    my( $repoid, $name ) = @ARGV;

    my $repo = &repository( $repoid );
    my $epm = &epm( $repo, $name );

    my $configdir = $epm->epm_dir . '/cfg';
    my $targetdir = $repo->config( "base_path" ) . '/archives/' . $repoid . '/cfg';

    use File::Compare;
	my ( $copies, $copied, $differs, $oks ) = ( 0, 0, 0, 0 );
	print "\n";
    File::Find::find(sub {
        return if $File::Find::name =~ /\/\./;
        return if -d $File::Find::name;

        my $path = $targetdir;
        $path .= "/" . substr($File::Find::dir,length($configdir)+1);

		if ( ! -e "$path/$_" )
		{
			if ( $force )
			{
				 EPrints->system->mkdir( $path );
				 File::Copy::copy( $File::Find::name, "$path/$_" );
				 print "$File::Find::name copied to $path/$_\n";
				 $copied++;
				 $oks++;

			}
			else
			{
				print "$path/$_ does not exist. Re-run with --force to copy from $File::Find::name\n";
				$copies++;
			}
		}
		elsif ( File::Compare::compare( $File::Find::name, "$path/$_" ) )
		{
			print "path/$_ differs to $File::Find::name and requires manual merging.\n";
			$differs++;
		}
		else
		{
			$oks++;
		}
    }, $configdir);

	if ( $copies > 0 || $differs > 0 )
	{
		print "\nWork to do: $copies files need to be copied and $differs files need to be manually merged. ($oks files are already correctly in place).\n\n";
	}
	else
	{
		print "\n" if $copied;
		print "No work to do: $oks files are already correctly in place.\n\n";
	}
}

=item check_symlinks

Checks symlinks created under lib/ are not broken.  Use C<--force> to remove 
them.

=cut

sub action_check_symlinks
{
    pod2usage() if @ARGV != 0;

	my $lib_dir = Cwd::abs_path( $FindBin::Bin . "/../../../lib" );
	File::Find::find(\&_broken_symlinks, $lib_dir );
}

sub _broken_symlinks
{
	if ( -l && !-e )
	{
		$broken_symlinks++;
		if ( $force ) 
		{
			 print "Deleting broken symlink: $File::Find::name\n";
			 unlink($_) or die "Can't unlink $File::Find::name: $!\n";
		}
		else
		{
			print "Broken symlink: $File::Find::name\n";
		}
	}
}


=item disable I<repository> I<package>

Disable the I<package> for I<repository>. This will trigger a configuration
reload.

=cut

sub action_disable
{
	pod2usage() if @ARGV != 2;
	my( $repoid, $name ) = @ARGV;

	my $repo = &repository( $repoid );
	my $epm = &epm( $repo, $name );

	local $handler->{dataobj} = $epm;

	my $retain = undef;
	$retain = 0 if $opt_force;
	$retain = 1 if $opt_retain;
	$epm->control_screen(
		processor => $handler,
		retain => $retain,
	)->action_disable;
}

=item enable I<repository> I<package>

Enable the I<package> for I<repository>. This will trigger a configuration
reload.

=cut

sub action_enable
{
	pod2usage() if @ARGV != 2;
	my( $repoid, $name ) = @ARGV;

	my $repo = &repository( $repoid );
	my $epm = &epm( $repo, $name );

	local $handler->{dataobj} = $epm;

	$epm->control_screen(
		processor => $handler,
	)->action_enable( 0, $force );
}

=item install I<package_path>

Install a package located at I<package_path>.

=cut

sub action_install
{
	my( $repo ) = @_;

	pod2usage( 2 ) if @ARGV != 1;

	my( $source ) = @ARGV;

	open(my $fh, "<", $source) or die "Error reading $source: $!";
	sysread($fh, my $xml, -s $fh);
	close($fh);

	my $epm = $repo->dataset( "epm" )->dataobj_class->new_from_xml( $repo, $xml );

	if( $epm->install( $handler, $force ) )
	{
		print "Installed ".$epm->value( "epmid" )." [$source]\n";
	}
}

=item link_lib I<package>

Soft-link all files in the package under lib/ to a directory tree lib/ below
the package's home directory. This is a utility method for developers.

Use --force to overwrite existing files.

=cut

sub action_link_lib
{
	my( $repo ) = @_;

	pod2usage( 2 ) if @ARGV != 1;

	my( $name ) = @ARGV;

	my $epm = &epm( $repo, $name );

	my $sourcedir = $epm->epm_dir . '/lib';
	my $targetdir = $repo->config( "base_path" ) . '/lib';

	my @installed_files = $epm->installed_files;
	my @installed_filenames = map { $sourcedir . '/' . $_->value( "filename" ) } @installed_files;

	File::Find::find(sub {
		return if $File::Find::name =~ /\/\./;
		return if -d $File::Find::name;
		return unless grep /^$File::Find::name$/, @installed_filenames;

		my $path = $targetdir;
		$path .= "/" . substr($File::Find::dir,length($sourcedir)+1);

		EPrints->system->mkdir( $path );

		if( $opt_force && -e "$path/$_" ) {
			unlink "$path/$_";
		}
		symlink($File::Find::name, "$path/$_");

		print "Created symlink: $path/$_\n";
	}, $sourcedir);
}

=item list

List all installed packages.

=cut

sub action_list
{
	my( $repo ) = @_;

	$dataset->dataobj_class->map($repo, sub {
		my( undef, undef, $epm ) = @_;

		print sprintf("%s\t%s\n", $epm->id, $epm->value( "version" ));
	});
}

=item rebuild

Rewrite the .epm and .epmi files. This is a utility method for developers.

=cut

sub action_rebuild
{
	my( $repo ) = @_;

	pod2usage( 2 ) if @ARGV != 1;

	my( $name ) = @ARGV;

	my $epm = &epm( $repo, $name );

	$epm->rebuild;

	$epm->commit;

	print $epm->epm_dir . "/" . $epm->id . ".epm\n";
}

=item uninstall I<package>

Uninstall the installed package I<package>.

=cut

sub action_uninstall
{
	my( $repo ) = @_;

	pod2usage( 2 ) if @ARGV != 1;

	my( $name ) = @ARGV;

	my $epm = &epm( $repo, $name );

	my @enabled_in;
	foreach my $repoid (EPrints->repository_ids)
	{
		last if $force;
		my $repo = EPrints->repository( $repoid );
		my $repo_epm = $repo->dataset( "epm" )->make_dataobj( $epm->get_data );

		if( $repo_epm->is_enabled )
		{
			push @enabled_in, $repoid;
		}
	}
	die "Can't uninstall while package is enabled in: ".join(', ', @enabled_in) if @enabled_in;

	if( $epm->uninstall( $handler, $force ) )
	{
		print "Uninstalled $name\n";
	}
}

=item unlink_lib I<package>

Remove soft-links for all files in the package under lib/ to a directory tree lib/ 
below the package's home directory. This is a utility method for developers.

=cut

sub action_unlink_lib
{
    my( $repo ) = @_;

    pod2usage( 2 ) if @ARGV != 1;

	use File::Basename;

    my( $name ) = @ARGV;

    my $epm = &epm( $repo, $name );

	my @enabled_in;
    foreach my $repoid (EPrints->repository_ids)
    {
        last if $force;
        my $repo = EPrints->repository( $repoid );
        my $repo_epm = $repo->dataset( "epm" )->make_dataobj( $epm->get_data );

        if( $repo_epm->is_enabled )
        {
            push @enabled_in, $repoid;
        }
    }
    die "Can't unlink while package is enabled in: ".join(', ', @enabled_in) if @enabled_in;

	my $sourcedir = $epm->epm_dir . '/lib';
    my $targetdir = $repo->config( "base_path" ) . '/lib';

	my @installed_files = $epm->installed_files;
	my @installed_filenames = map { $sourcedir . '/' . $_->value( "filename" ) } @installed_files;

	File::Find::find(sub {
        return if $File::Find::name =~ /\/\./;
        return if -d $File::Find::name;
	return unless grep /^$File::Find::name$/, @installed_filenames;


        my $path = $targetdir;
        $path .= "/" . substr($File::Find::dir,length($sourcedir)+1);

        if( -e "$path/$_" ) {
            unlink "$path/$_";
        }

		my $rm_path = $path;
		my $empty_dir = EPrints::Utils::is_empty_dir( $rm_path );
		print "Removed symlink: $path/$_\n";
		while ( $empty_dir )
		{
			rmdir $rm_path;
			print "Removed directory: $rm_path\n";
			$rm_path = dirname( $rm_path );
			$empty_dir = EPrints::Utils::is_empty_dir( $rm_path );
		}
    }, $sourcedir);
}


=item unpack I<package_path>

Unpack the files contained in package_path to the current directory. This is
equivalent to tar -xf package_path.

=cut

sub action_unpack
{
	my( $repo ) = @_;

	pod2usage( 2 ) if @ARGV != 1;

	my( $source ) = @ARGV;

	open(my $fh, "<", $source) or die "Error reading $source: $!";
	sysread($fh, my $xml, -s $fh);
	close($fh);

	my $doc = $repo->xml->parse_string( $xml );
	my $epdata = $repo->dataset( "epm" )->dataobj_class->xml_to_epdata( $repo, $doc->documentElement );

	# This is a bit of a hack to get at the tmp files.
	my $files_data;
	foreach my $document ( @{$epdata->{documents}} )
	{
		foreach my $file ( @{$document->{files}} )
		{
			$files_data->{$file->{filename}} = read_file( $file->{_content} );
		}
	}

	my $epm = $repo->dataset( "epm" )->make_dataobj( $epdata );
	if ( $opt_to_link )
	{
		my $epmid = $epm->id;
		foreach my $file ($epm->installed_files)
		{
			#next unless ( !$file->value( 'content' ) || $file->value( 'content' ) eq "install" );
			my $filepath = $file->value( "filename" );
			if( $filepath =~ m#^/# || $filepath =~ m#/\.# )
			{
				warn "Won't unpack root-pathed or hidden file: $filepath";
				next;
			}
			if ( $filepath =~ m#^epm/$epmid/# )
			{	
				$filepath =~ s#^epm/$epmid/##;
				$filepath = $repo->config( "base_path" ) . '/lib/epm/' . $epmid . '/' . $filepath;
			}
			else
			{
				$filepath = $repo->config( "base_path" ) . '/lib/epm/' . $epmid . '/lib/' . $filepath;
			}
			my( @path, $filename ) = split '/', $filepath;
			for(0..($#path-1))
			{
				my $path = join '/', @path[0..$_];
				EPrints->system->mkdir($path)
					or die "mkdir $path: $!";
			}
			if( !$opt_force && -e $filepath )
        	{
				die "Use --force to overwrite $filepath\n";
			}
			open(my $fh, ">", $filepath) or die "Error writing to $filepath: $!";
			syswrite($fh, $files_data->{$file->value( "filename" )} );
			close($fh);
			print "Unpacked: $filepath\n" if $noise;
		}
	}
	else 
	{
		foreach my $file ($epm->installed_files)
		{
			my $filepath = $file->value( "filename" );
	
			if( $filepath =~ m#^/# || $filepath =~ m#/\.# )
			{
				warn "Won't unpack root-pathed or hidden file: $filepath";
				next;
			}
			$filepath = 'lib/' . $filepath;
			my( @path, $filename ) = split '/', getcwd() . '/' . $filepath;
			for(0..($#path-1))
			{
				my $path = join '/', @path[0..$_];
				EPrints->system->mkdir($path)
					or die "mkdir $path: $!";
			}
			if( !$opt_force && -e $filepath )
			{
				die "Use --force to overwrite $filepath\n";
			}
			open(my $fh, ">", $filepath) or die "Error writing to $filepath: $!";
			syswrite($fh, $files_data->{$file->value( "filename" )} );
			close($fh);
			print "Unpacked: $filepath\n" if $noise;
		}
	}
}


=back

=cut

=head1 COPYRIGHT

=for COPYRIGHT BEGIN

Copyright 2024 University of Southampton.
EPrints 3.4 is supplied by EPrints Services.

http://www.eprints.org/eprints-3.4/

=for COPYRIGHT END

=for LICENSE BEGIN

This file is part of EPrints 3.4 L<http://www.eprints.org/>.

EPrints 3.4 and this file are released under the terms of the
GNU Lesser General Public License version 3 as published by
the Free Software Foundation unless otherwise stated.

EPrints 3.4 is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with EPrints 3.4.
If not, see L<http://www.gnu.org/licenses/>.

=for LICENSE END