#!/usr/bin/perl -w

use 5.006;
use strict;
use warnings;

use Pod::Usage;
use Getopt::Long;
use Gear::Rules 0.191;
use File::Basename;
use RPM::Source::Editor;
use Source::Bundle::Archive;
use String::ShellQuote;

my $verbose_default=1;
my $verbose=$verbose_default;
my $opt_sourcenum=0;
my ($opt_version, $opt_tarball, $help, @opt_hook);
my $script_prefix='__~.uupdate-step-';
my $opt_destdir='.git/uupdate';
my ($opt_unpack,$opt_merge,$opt_update_spec, $opt_force_unpack,$opt_exclude_pattern);
my ($opt_override_spec,$opt_specgen,$opt_git_object,$opt_changelog);
# not yet opt
my $opt_git_interactive_merge=0;

my $options_result = 
    GetOptions (
	"h|help"   => \$help,
	"ch|changelog=s" => \$opt_changelog,
	"destdir=s" => \$opt_destdir,
	"exclude=s" => \$opt_exclude_pattern,
	"force-unpack" => \$opt_force_unpack,
	"hook=s" => \@opt_hook,
	"source=i" => \$opt_sourcenum,
	"specgen" => \$opt_specgen,
	"upstream-version=s" => \$opt_version,
	"merge" => \$opt_merge,
	"override-spec=s" => \$opt_override_spec,
	"prefix" => \$script_prefix,
	"update-spec" => \$opt_update_spec,
	"unpack" => \$opt_unpack,
	"commit=s" => \$opt_git_object,
	"tag=s" => \$opt_git_object,
	"verbose+"  => \$verbose,
	"quiet"  => sub {$verbose=0},
    );

sub exit_usage {
    #exec "pod2usage --exit=0 $0";
    pod2usage({ #-message => "the options below are package-specific:" ,
	-exitval => 0  ,
	-verbose => $verbose ? $verbose - $verbose_default : 0,
	#-output  => $filehandle
	      } );
}

my $partial_mode= $opt_merge || $opt_unpack || $opt_update_spec;
my ($do_upstream,$do_merge,$do_spec)=(1,1,1);
($do_upstream,$do_merge,$do_spec)=(0,0,0) if $partial_mode;
$do_upstream =1 if $opt_unpack;
$do_merge =1 if $opt_merge;
$do_spec =1 if $opt_update_spec;
my $need_gear_update_tag=0;

if ($help or @ARGV>2 or not defined $opt_version and @ARGV==1
    or not @ARGV and not $opt_version and not $opt_git_object
) {
    &exit_usage();
}

my $possible_source = shift @ARGV;
$opt_version = shift @ARGV if not defined $opt_version;

if (not defined $possible_source) {
    unless (defined $opt_tarball or defined $opt_git_object) {
	&exit_usage();
    }
} else {
    if (-e $possible_source and not -d $possible_source) {
	$opt_tarball=$possible_source;
    } elsif (not defined $opt_git_object and &fetch_git_object_and_check_type($possible_source)) {
	$opt_git_object=$possible_source;
    } else {
	die "Invalid input: $possible_source is not a file or git commit!\n";
    }
}

if (defined $opt_tarball) {
    die "file $opt_tarball does not exists!\n" if ! -e $opt_tarball;
    die "$opt_tarball is a directory - not supported!\n" if -d $opt_tarball;
}
if (defined $opt_git_object) {
    my $type=&fetch_git_object_and_check_type($opt_git_object);
    die "object $opt_git_object not found in current git.\n" unless $type;
}

my $rules=Gear::Rules->new();
my $specfile=$rules->get_spec();

my $spec=RPM::Source::Editor->new(
    SPECFILE=>$specfile,
    );
my $specmacros=$spec->macros;
if ($rules->get_specsubst) {
    my @nvr=map {$specmacros->macro_subst($_)} $rules->get_nvr;
    # known supported case alt@rel@1
    $nvr[2]='alt1' if $nvr[2] =~/^alt\@\w+\@\d/;
    die 'FATAL: Gear::Rules: name-version-release '.join('-',@nvr)." depend on X-gear-specsubst: tag for the specsubst: command - not supported yet\n" if grep {/\@\w+\@/} @nvr;
}

# TODO: using private internals !!! :(
# like get_tag
my $source0=$specmacros->macro_subst($spec->raw_sourcelist_ref->[$opt_sourcenum]);
die "can't find Source$opt_sourcenum\n" unless $source0;

my $source0rule=$rules->match_srpm_file($source0,$specfile);
die "can't find a matching rule for Source$opt_sourcenum: $source0\n" unless $source0rule;
my ($pkgname,$pkgversion,$pkgrelease)=$rules->get_nvr();
my ($source0_git_path) = $source0rule->git_paths();
my $source0tree=$source0rule->{-tree};

if ($opt_tarball and $rules->__has_external_commits()) {
    die "Commits from external repository found.
The tarball update seems to be not the right method of repository update.
If you insist, use --force-unpack option\n" unless $opt_force_unpack;
    warn "Commits from external repository found, Tarball update will mess with them.\n";
}
if ($source0tree eq '.' and $opt_git_object) {
    die "Invalid gear structure - if you are updating from external VCS, you should create tar from tag or branch\n";
}

my $layout_analysis=$rules->__is_gear_layout_not_robot_recognizeable($source0rule);
die "Gear layout is not ready for automatic update: $layout_analysis\n" if ($layout_analysis);

unlink glob (&get_script_prefix_with_path()."*");

my @diffs=$rules->sorted_diff_rules();
my $current_git_branch=&Gear::Git::Helper::get_current_git_branch();
$current_git_branch||=&Gear::Git::Helper::get_git_commit('HEAD');
my $default_upstream_branch_name='upstream';

my %TAG=map{$_=>1} &Gear::Git::Helper::ls_git_tags();
my $BRANCH=&Gear::Git::Helper::get_git_branch_commit_hash();
my $fh;
my @NEW_NVR=($pkgname, $opt_version,'alt1');
my $script_count=0;

my @MASTER_MERGE_DEFAULT;
my @MASTER_MERGE_OURS;

my $commit2branch={};
foreach my $branch (keys(%$BRANCH)) {
    my $commit=$BRANCH->{$branch};
    my $ref=$commit2branch->{$commit};
    unless ($ref) {
	$ref=[];
	$commit2branch->{$commit}=$ref;
    }
    push @$ref, $branch;
}

if ($do_upstream) {
    if ($opt_tarball) {
	&print_upstream_tarball_update();
    } elsif ($opt_git_object) {
	&print_upstream_tag_update();
    } else {
	die "Oops! internal error (no upstream)";
    }
}

if ($do_merge and @diffs) {
    foreach my $diff (@diffs) {
	my @git_paths=$diff->git_paths();
	if ($diff->{-tree2} eq '.') {
	    # master branch; we will checkout it later...
	    push @MASTER_MERGE_DEFAULT, &get_tag_new_nvr($git_paths[0]);
	} else {
	    &new_uupdate_script('merge2diff');
	    print $fh "#!/bin/sh -ve\n";
	    print $fh '# diff rule at line ', $diff->linenum, ': ',$diff->rulestring(),"\n";
	    &git_checkout_old_nvr($fh, $git_paths[1], 'diff_rule_line_'.$diff->linenum);
	    print $fh 'git pull . ',&get_tag_new_nvr($git_paths[0]),"\n";
	    &git_create_tag($fh, $git_paths[1]);
	    push @MASTER_MERGE_DEFAULT, &get_tag_new_nvr($git_paths[1]);
	}
    }
}

if ($source0tree ne '.') {
    my $merge_tag=&get_tag_new_nvr($source0_git_path);
    if (not grep {$_ eq $merge_tag} @MASTER_MERGE_DEFAULT,@MASTER_MERGE_OURS) {
	my $merge_strategy=$rules->__guess_merge_strategy($source0_git_path->{'commit'},'HEAD');
	if (not $merge_strategy) {
	    push @MASTER_MERGE_DEFAULT, $merge_tag;
	} elsif ($merge_strategy eq 'ours') {
	    push @MASTER_MERGE_OURS, $merge_tag;
	} else {
	    die "Oops: merge strategy $merge_strategy is not implemented. Please, report.";
	}
    }
}

&print_master_merge() if $do_merge and (@MASTER_MERGE_DEFAULT or @MASTER_MERGE_OURS);
&print_update_spec() if $do_spec;

sub print_upstream_tarball_update {
    &new_uupdate_script('upstream-tarball-update');
    print $fh '#!/bin/sh -ve',"\n";
    print $fh qq!# upstream tree: !.$source0tree,"\n";
    if ($source0tree ne '.') {
	&git_checkout_old_nvr($fh, $source0_git_path, $default_upstream_branch_name);
    }
    my $upstream_subdir=$source0_git_path->{'path'};
    my $tarball_obj=Source::Bundle::Archive->new(-file=>$opt_tarball);
    my @depth=$tarball_obj->depth();
    warn "$opt_tarball has depth ".(scalar @depth)."Check the update by hands!\n" if @depth>1;
    my @gear_update_opt;
    push @gear_update_opt,'--exclude', $opt_exclude_pattern if $opt_exclude_pattern;
    if (@depth==0) {
	push @gear_update_opt,'-a';
	warn "$opt_tarball has depth 0. using gear-update -a\n" if $verbose;
    }
    my $gear_update_opt=join (' ', shell_quote_best_effort @gear_update_opt);
    if ($upstream_subdir eq '.') {
	my $new_tarball_path=$opt_destdir ? $opt_destdir.'/'.basename($opt_tarball) : $opt_tarball;
	print $fh 
	    "# move away $opt_tarball or it will appear as an untracked file to gear-update\n", 
	  qq{mkdir -p "$opt_destdir"},"\n", 
	  qq{mv -f "$opt_tarball" "$new_tarball_path"},"\n" if $new_tarball_path ne $opt_tarball;
	print $fh qq!gear-update $gear_update_opt -f "$new_tarball_path" !.$upstream_subdir,"\n";
	print $fh qq!mv -f "$new_tarball_path" "$opt_tarball"!,"\n" if $new_tarball_path ne $opt_tarball;
    } else {
	print $fh qq!gear-update $gear_update_opt "$opt_tarball" !.$upstream_subdir,"\n";
    }
    print $fh "git commit -m $opt_version\n";
    if ($source0tree ne '.') {
	&git_create_tag_new_nvr($fh, $source0_git_path);
	print $fh "git checkout -q $current_git_branch\n";
    }
}

sub print_upstream_tag_update {
    &new_uupdate_script('upstream-tag-update');
    print $fh '#!/bin/sh -ve',"\n";
    print $fh qq!# upstream tree: !.$source0tree,"\n";
    die "Oops! internal. upstream_tag_update but gear rule is like tar:." if $source0tree eq '.';
    my $tag_name=&get_tag_new_nvr($source0_git_path);
    if (grep {$tag_name eq $_} &Gear::Git::Helper::ls_git_tags()) {
	print $fh qq!# tag !,$tag_name," already exists, nothing to do.\n";
    } else {
	if (&Gear::Rules::template_is_likely_a_tag($source0_git_path->{'tag_template'})) {
	    print $fh "git tag -s -m $tag_name $tag_name $opt_git_object\n";
	}
    }
}

sub print_master_merge {
    &new_uupdate_script('merge2master');
    print $fh '#!/bin/sh -ve',"\n";
    print $fh "git checkout -q $current_git_branch\n";

    my $nointeractive='--no-edit ';
    $nointeractive='' if $opt_git_interactive_merge;

    print $fh "git merge ", $nointeractive, join(' ',@MASTER_MERGE_DEFAULT), "\n" if @MASTER_MERGE_DEFAULT;
    print $fh "git merge -s ours ", $nointeractive, join(' ',@MASTER_MERGE_OURS), "\n" if @MASTER_MERGE_OURS;
    $need_gear_update_tag=1;
}

sub print_update_spec {
    &new_uupdate_script('update-spec');
    my @script;
    my $specfile_to_update=$specfile;
    if ($opt_specgen) {
	if (-e "specs/$specfile") {
	    $specfile_to_update="specs/$specfile";
	} else {
	    die "gear-uupdate: --specgen but specs/$specfile not found.\n";
	}
    }
    if ($opt_override_spec) {
	push @script, [qw/rm -f/, $specfile_to_update];
	push @script, [qw/cp -f/, $opt_override_spec, $specfile_to_update];
    } else {
	my @line;
	push @line, qw/srpmnmu -i --version/, $opt_version, '--spec', $specfile_to_update;
	my $changelog="- new version $opt_version";
	$changelog=$ENV{'GEAR_UUPDATE_CHANGELOG'} if $ENV{'GEAR_UUPDATE_CHANGELOG'};
	$changelog=$opt_changelog if $opt_changelog;
	push @line, '--changelog', $changelog;
	foreach my $hook (@opt_hook) {
	    push @line, '--hook', $hook;
	}
	push @script, \@line;
    }
    push @script, [qw/git add/, $specfile_to_update];
    if ($opt_specgen) {
	push @script, [qw/specgen/];
	push @script, [qw/git add/, $specfile];
    }
    push @script, [qw/gear-update-tag -ac/] if $need_gear_update_tag;
    print $fh &runarray2sh(\@script);
    print $fh "rmdir $opt_destdir 2>/dev/null ||:\n";
}

sub git_checkout_old_nvr {
    my ($fh, $git_paths,$fallback_branch_name)=@_;
    my $location_name=$git_paths->{'tag'};
    my $commit=$git_paths->{'commit'};
    my $branch_name;
    #print $fh '# nested call: git_checkout_old_nvr(...',",$fallback_branch_name)\n";

    if (&Gear::Rules::template_is_likely_a_tag($git_paths->{'tag_template'})) {
	print $fh 'git checkout '.&_tag2git($git_paths),"\n";
	my $find_branch=$commit2branch->{$commit};
	if ($find_branch) {#  and $find_branch->[0]
	    if (grep {$_ eq $location_name} @$find_branch) {
		$branch_name=$location_name;
	    }
	    print $fh "# appropriate branches for $commit: ",join(',',@$find_branch),"\n";
	    $branch_name=$find_branch->[0];
	    $branch_name=undef if $branch_name eq 'master';
	}
    }
    $branch_name=$fallback_branch_name unless defined $branch_name;
    if ($BRANCH->{$branch_name}) {
	if ($BRANCH->{$branch_name} eq $commit) {
	    print $fh "git checkout $branch_name\n" if $current_git_branch ne $branch_name;
	    return;
	} else {
	    print $fh "git branch -D $branch_name\n";
	}
    }
    print $fh "git checkout -q -b $branch_name ".$git_paths->{'commit'}."\n";
    return;
}

sub get_script_prefix_with_path {
    return ($opt_destdir ? $opt_destdir.'/' : '') . $script_prefix;
}

sub new_uupdate_script {
    my ($script_name)=@_;
    $script_count++;
    close ($fh) if $fh;
    `mkdir -p "$opt_destdir"` if ($opt_destdir && ! -d $opt_destdir);
    my $filename= &get_script_prefix_with_path() .
	('0' x (3-length($script_count)))."$script_count-$script_name.sh";
    print STDERR "Writing: $filename\n" if $verbose;
    open ($fh, '>', $filename) or die "can't create $filename: $!";
    chmod(0755, $fh);
}

sub git_create_tag_new_nvr {
    my ($fh, $git_paths)=@_;
    my $tag_name=&get_tag_new_nvr($git_paths);
    if (&Gear::Rules::template_is_likely_a_tag($git_paths->{'tag_template'})) {
	print $fh "git tag -s -m $tag_name $tag_name\n";
    }
}

sub get_tag_new_nvr {
    my ($git_paths)=@_;
    return &Gear::Rules::subst_gear_nvr($git_paths->{'tag_template'},@NEW_NVR);
}

sub fetch_git_object_and_check_type {
    my ($git_object)=@_;
    my $type=_git_object_check_type($git_object);
    if (not $type and -f '.gear/upstream/remotes' and -x '/usr/bin/gear-fetch-remotes') {
	&run('/usr/bin/gear-fetch-remotes');
	$type=_git_object_check_type($git_object);
    }
    return $type;
}

sub _git_object_check_type {
    my ($git_object)=@_;
    my $type=`git cat-file -t $git_object`;
    chomp $type;
    if ($?) {
	return undef;
    } elsif ($type ne 'tag' and $type ne 'commit') {
	# note: unsigned tags also have the commit type.
	die "object $opt_git_object has type $type but only commit or tag is supported.\n";
    }
    return $type;
}


sub _tag2git {
    my ($git_paths)=@_;
    my $tag=$git_paths->{'tag'};
    return $tag if $TAG{$tag};
    return $git_paths->{'commit'};
}

sub runarray2sh {
    my ($scriptptr)=@_;
    print $fh '#!/bin/sh -xe',"\n";
    foreach my $lineptr (@$scriptptr) {
	print $fh join (' ', shell_quote_best_effort @$lineptr), "\n";
    }
}

sub runarray {
    my ($scriptptr)=@_;
    foreach my $lineptr (@$scriptptr) {
	&run(@$lineptr);
    }
}

sub run {
    print STDERR "running: ", join(' ',@_),"\n";
    system(@_)==0 or die "command failed: ".join(' ',@_);
}



=head1	NAME

gear-uupdate - debian uupdate for gear repositories.

=head1	SYNOPSIS

B<gear-uupdate,gear-uupdate-prepare>
[B<-h,--help>] 
[B<-v,--verbose>]
[B<-q,--quiet>]
[B<--ch,--changelog> I<message>]
[B<--force-unpack>]
[B<--destdir> I<dir>]
[B<--source> I<sourcenum>]
[B<--prefix> I<script prefix>]
[B<--hook> I<path/to/hook>]
[B<--unpack>]
[B<--merge>]
[B<--update-spec>]
[B<--override-spec> I<new spec file>]
[B<--upstream-version> I<new version>]
[B<--commit> I<git commit>]
[B<--tag> I<git tag>]
[I<tarball> [ I<new version> ]]

=head1	DESCRIPTION

B<gear-uupdate-prepare,gear-uupdate>
Update gear repository together with rpm-uscan. gear-uupdate is a wrapper 
for gear-uupdate-prepare and gear-uupdate-execute.

This command is issued indirectly by rpm-uscan or gear-cronbuild.
It can be also used manually to update gear repository from tarball.

=head1	OPTIONS

=over

=item	B<--upstream-version> I<new version>

New upstream version.

=item	B<--unpack,--merge,--update-spec>

Write scripts for specified stages only (unpack upstream tarball, merge branches, update spec).

=item	[B<--prefix> I<script prefix>]

Use specified prefix for the scripts.
Default is '__~.uupdate-step-'.

=item	[B<--source> I<sourcenum>]

Sourcenum is the rpm number of the source file watched,
Default is 0.

=item	[B<--destdir> I<dir>]

Alternative directory to store generated scripts. 

=item	[B<--force-unpack>]

Force update repository ignoring precence of external commits.

=item	[B<--ch,--changelog> I<message>]

RPM spec file changelog message. Default is '- new version <version>'

=item	B<--hook> I</path/to/hook>

Path to a perl-RPM-Source-Editor hook program to perform on the input packages.
This option can be repeated to load any number of hooks.

=item	[B<--override-spec> I<new spec file>]

By default, spec will be updated using call to srpmnmu:
srpmnmu -i --version <new version> --changelog "- new version <new version>" \
 [ --hook <hook>  ... ]
You can override this call with your own pre-edited spec file.

For example:
specfile=`gear-rules-print-specfile`
cp $specfile /safe/place
edit /safe/place/$specfile
gear-uupdate [ ... ] --override-spec /safe/place/$specfile

=item	B<-h, --help>

Display this help and exit.

=back

=head1	ENVIRONMENT VARIABLES

B<GEAR_UUPDATE_CHANGELOG> - default changelog

=head1	AUTHOR

Written by Igor Vlasenko <viy@altlinux.org>.

=head1	COPYING

Copyright (c) 2011-2016 Igor Vlasenko, ALT Linux Team.

This is free software; you can redistribute it and/or modify it under the terms
of the GNU General Public License as published by the Free Software Foundation;
either version 2 of the License, or (at your option) any later version.

=cut

