package App::Updater;
use strict;
use warnings;
use utf8;
use feature qw/say/;

=encoding utf-8

=head1 NAME

updater - a command-line tool to mass-update multiple version-controlled projects

=head1 SYNOPSIS

    use App::Updater;

    my $app = App::Updater->new(...);

    exit $app->run ? 0 : 1;

=head1 DESCRIPTION

The updater tool provides a unified way to update directory structures
containing multiple version-controlled projects (e.g., Git, SVN, etc.).
With a single command, users can synchronize all subdirectories to their
latest state by automatically executing update commands such as git pull
or svn up in each repository. This simplifies and automates the process
of keeping multiple projects up to date.

=head1 METHODS

This class implements the following methods

=head2 backup

    $app->backup("./.updater.yml", [...]);

Saves YAML file that contains the data of work directory

=head2 execmd

    my $ret = $app->execmd("command", "arg1", "arg2", "argn");

Performs execute system commands and returns hash:

    {
        command => 'noop',
        status  => 1,
        err_msg => '',
        err     => '',
        out     => '',
    }

=over 4

=item command

The system command string

=item status

Status: 1 - Ok, 0 - Error

=item err_msg

System error message, no C<STDERR>!

=item err

C<STDERR> in string format

=item out

C<STDOUT> in string format

=back

=head2 init_makefile

    $app->init_makefile();
    $app->init_makefile(FORCE_INIT);

Initializes Makefile file to make updates easier

=head2 raise

    return $app->raise("Mask %s", "val");
    return $app->raise("val");

Prints message to STDERR

=head2 restore

    $app->restore("./.updater.yml");

Loads YAML file that contains the data of work directory and restore each project of this file

=head2 startup

Acrux application internal startup method

=head2 update

    $app->update($rule, $dir, @commands);

Performs update projects of work directory

=head1 HISTORY

See C<Changes> file

=head1 TO DO

See C<TODO> file

=head1 SEE ALSO

L<Acme::Crux>

=head1 AUTHOR

Serż Minus (Sergey Lepenkov) L<https://www.serzik.com> E<lt>abalama@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright (C) 1998-2025 D&D Corporation. All Rights Reserved

=head1 LICENSE

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

See C<LICENSE> file and L<https://dev.perl.org/licenses/>

=cut

our $VERSION = "3.10";

use parent qw/Acme::Crux/;

use Cwd qw/getcwd realpath/;
use ExtUtils::MakeMaker;
use File::Find qw/find/;
use File::Spec;
use File::Path qw/make_path/;
use FindBin qw/$RealScript $RealBin/;
use URI;
use URI::file;
use YAML qw/LoadFile DumpFile/;
use IPC::Cmd qw//;
use Text::ParseWords qw/shellwords/;

## Acrux requires
use Acrux::FilePid;
use Acrux::Util qw/color is_os_type dformat dtf slurp trim dumper/;
use Acrux::RefUtil qw/is_array_ref is_hash_ref isnt_void/;

use constant {
        PROJECTNAME         => "Updater",
        PROJECTNAMEL        => "updater",
        CMDDEFAULT          => "update",
        PIDFILE             => '.updater.pid',
        YMLFILE             => '.updater.yml',
        MAKEFILE            => 'Makefile',
        UPDATER_FILE        => '.updater',
        UPDATER_TIMEOUT     => $ENV{UPDATER_TIMEOUT} || 60,

        # Flags
        FORCE_INIT          => 1,

        # VCS definitions
        VCS => {
            # GIT
            git => {
                fs_sign => '.git',
                update  => 'git pull',
                checkout=> 'git clone [URL] [DIR]',
                get_url => 'git config --get remote.origin.url',
            },

            # SVN
            svn => {
                fs_sign => '.svn',
                update  => 'svn update',
                checkout=> 'svn checkout [URL] [DIR]',
                get_url => 'svn info --show-item url',
            },

            # Mercurial (hg)
            mercurial => {
                fs_sign => '.hg',
                update  => 'hg pull -u',
                checkout=> 'hg clone [URL] [DIR]',
                get_url => 'hg paths default',
            },

            # Fossil
            fossil      => {
                fs_sign => '.fslckout',
                update  => 'fossil update',
                checkout=> 'fossil clone [URL] [REPO] && fossil open [REPO] [DIR]',
                get_url => 'fossil info | grep "repository:" | awk \'{print $2}\'',
            },
        },

        # CMD
        TRUE_CMD            => 'true',
        FALSE_CMD           => 'false',

        # Makefile macroses
        PHONY               => [qw/all usage help update up clean list ls/],
    };

sub startup {
    my $self = shift;

    # Check work (data) directory
    return $self->raise("Work directory `%s` not found", $self->datadir)
        unless length($self->datadir) && (-d $self->datadir or -l $self->datadir);
    my $datadir = realpath($self->datadir());
    $self->datadir($datadir);

    # Set PID file
    $self->pidfile(File::Spec->catfile($datadir, PIDFILE));

    return $self;
}

sub raise {
    my $self = shift;
    say STDERR color "bright_red" => @_;
    return 0;
}

__PACKAGE__->register_handler(
    handler     => "version",
    aliases     => "ver v V",
    description => "Project version",
    code => sub {
### CODE:
    my ($self, $meta, @arguments) = @_;
    printf "%s (%s) Version %s\n", PROJECTNAME, PROJECTNAMEL, $self->VERSION;
    return 1;
});

# perl -Ilib bin/updater -d status
__PACKAGE__->register_handler(
    handler     => "status",
    aliases     => "st info",
    description => "Get status information",
    code => sub {
### CODE:
    my ($self, $meta, @arguments) = @_;
    my $fp = Acrux::FilePid->new(file => $self->pidfile);
    my $pid = $fp->running;

    printf("Version         : %s\n", $self->VERSION);
    printf("Data dir        : %s\n", $self->datadir);
    printf("Temp dir        : %s\n", $self->tempdir);
    printf("Script path     : %s\n", File::Spec->catfile($RealBin, $RealScript));
    printf("Process         : %s\n", $pid ? "running (PID=$pid)" : 'not running');
    #$self->debug(explain($self)) if $self->verbosemode;

    return 1;
});

# perl -Ilib bin/updater -d init
__PACKAGE__->register_handler(
    handler     => "init",
    aliases     => "ini initialize",
    description => "Init new system files",
    code => sub {
### CODE:
    my ($self, $meta, @arguments) = @_;
    my $fp = Acrux::FilePid->new(file => $self->pidfile);
    my $pid = $fp->running;
    return $self->raise("Program already running (PID=$pid)") if $pid;
    $fp->save;

    # Init Makefile
    $self->init_makefile(FORCE_INIT);

    $fp->remove;
    return 1;
});

# perl -Ilib bin/updater -d up
__PACKAGE__->register_handler(
    handler     => "update",
    aliases     => "up list ls backup bu",
    description => "Update/List processes. Update filestruct or show list of filestruct",
    code => sub {
### CODE:
    my ($self, $meta, @arguments) = @_;
    my $fp = Acrux::FilePid->new(file => $self->pidfile);
    my $pid = $fp->running;
    return $self->raise("Program already running (PID=$pid)") if $pid;
    $fp->save;

    # Show current dir
    printf "Working with \"%s\" directory\n", $self->datadir if $self->debugmode;

    # Init Makefile in soft mode (skip if exists)
    $self->init_makefile;

    # Show list only
    say "Show file list only, no real updates performs (--list)" if $self->option("list") && $self->debugmode;

    # Update or show list
    my @report;
    find({  follow      => 1,
            follow_skip => 2,
            no_chdir    => 0,
            wanted      => sub
    {
        my $fn = $_;
        my $dir = $File::Find::dir;
        return 0 if $dir eq $self->datadir;
        return 0 if $fn eq $self->datadir;
        my $r;
        if ($fn =~ /\.svn$/) {
            return 0 if -e UPDATER_FILE;
            $r = $self->update(svn => $dir, VCS()->{svn}{update});
        } elsif ($fn =~ /\.git$/) {
            return 0 if -e UPDATER_FILE;
            $r = $self->update(git => $dir, VCS()->{git}{update});
        } elsif ($fn =~ /\.hg$/) {
            return 0 if -e UPDATER_FILE;
            $r = $self->update(mercurial => $dir, VCS()->{mercurial}{update});
        } elsif ($fn =~ /\.fslckout$/) {
            return 0 if -e UPDATER_FILE;
            $r = $self->update(fossil => $dir, VCS()->{fossil}{update});
        } elsif ($fn =~ /\.updater$/) {
            my $cmds = slurp($fn);
            $r = $self->update(usr => $dir, split /(\r*\n)+/, $cmds);
        } elsif ($fn =~ /\.(skip|noop|no|none)$/) {
            $r = $self->update(noop => $dir);
        } else {
            return 0;
        }
        return 0 unless defined($r) && is_hash_ref($r); # Skip incorrect results
        push @report, $r;
    }}, $self->datadir);

    # Save report to YAML file
    $self->backup($self->option("yamlfile"), \@report) if scalar(@report);

    $fp->remove;
    return 1;
});

# perl -Ilib bin/updater -d res
__PACKAGE__->register_handler(
    handler     => "restore",
    aliases     => "res re",
    description => "Restore filestruct by specified yamlfile",
    code => sub {
### CODE:
    my ($self, $meta, @arguments) = @_;
    my $fp = Acrux::FilePid->new(file => $self->pidfile);
    my $pid = $fp->running;
    return $self->raise("Program already running (PID=$pid)") if $pid;
    $fp->save;

    # Restore filestruct
    my $exitval = $self->restore($self->option("yamlfile"));

    # Init Makefile in soft mode (skip if exists)
    $self->init_makefile;

    $fp->remove;
    return $exitval;
});

sub update {
    my $self = shift;
    my $rule = shift || ""; # Rule (svn, git, usr, etc.)
    my $dir = shift || ""; # Directory
    my @dir_cmds = @_; # Commands for directory

    # Out
    my @report; # Report
    my $url = ""; # URL
    my $res = {}; # Execute command result struct

    # Rel path calc
    my $rel = File::Spec->abs2rel( $dir, $self->datadir );

    # Prepare commands
    my @cmds = ();
    foreach my $p (@dir_cmds) {
        next unless defined($p) && length($p); # Skip: no command
        next if $p =~ /^\s+$/; # Skip: empty commands
        next if $p =~ /^\s*\#/; # Skip: comments
        push @cmds, trim($p);
    }
    # print dumper(\@cmds);

    # Get URL
    if ($rule eq 'svn') { # SVN
        $res = $self->execmd(VCS()->{$rule}{get_url});
        $url = URI->new($res->{out} || 'http://localhost')->as_string;
    } elsif ($rule eq 'git') { # GIT
        $res = $self->execmd(VCS()->{$rule}{get_url});
        $url = URI->new($res->{out} || 'http://localhost')->as_string;
    } elsif ($rule eq 'noop') { # Noop
        $url = "none";
    } else { # USR
        $url = URI::file->new_abs(UPDATER_FILE)->as_string;
    }
    if ($rule ne 'noop') {
        say color(bright_cyan => "%s → %s [%s]", uc($rule), $dir, $url);
    } else { # SKIP
        say color(bright_yellow => "%s → %s", "SKP", $dir);
        return;
    }
    if (defined($res->{err}) && length($res->{err})) {
        say color "bright_red" => "%s", $res->{err};
        push @report, {%$res}; # Errors only to report
    }

    # List only
    return {
        rule    => $rule,
        dir     => $dir,
        rel     => $rel,
        url     => $url,
    } if $self->option("list");

    # Run commands
    foreach my $cmd (@cmds) {
        printf "# %s\n", $cmd if $self->debugmode; # no color
        $res = $self->execmd($cmd); # Execute
        say color "bright_red" => "%s", $res->{err} if length $res->{err}; # red
        say $res->{out} if length $res->{out}; # no color
        push @report, {%$res}; # To report
    }
    say color(bright_yellow => "Skipped! No commands found") if !scalar(@cmds) && $self->debugmode;

    # Reporting
    return {
        rule        => $rule,
        dir         => $dir,
        rel         => $rel,
        url         => $url,
        commands    => [@report],
    };
}
sub backup {
    my $self = shift;
    my $yamlfile = shift || File::Spec->catfile($self->datadir, YMLFILE);
    my $report = shift;
    #print dumper($report);

    # Debug
    printf "Backup filestruct of \"%s\" to \"%s\"\n", $self->datadir, $yamlfile
        if $self->debugmode;

    # Save data to yamlfile
    DumpFile($yamlfile, $report) if is_array_ref($report);

    return 1;
}
sub restore {
    my $self = shift;
    my $yamlfile = shift || File::Spec->catfile($self->datadir, YMLFILE);
    return $self->raise("YAML file not exists: %s", $yamlfile) unless -e $yamlfile;

    # Debug
    printf "Restore filestruct of \"%s\" by \"%s\"\n", $self->datadir, $yamlfile
        if $self->debugmode;

    # Load YAML file
    my $yaml = LoadFile($yamlfile);
    return $self->raise("Can't load YAML file: %s", $yamlfile) unless is_array_ref($yaml);

    # Restore
    foreach my $rec (@$yaml) {
        #print dumper $rec;
        my $rel = $rec->{rel};
           next unless $rel;
        unless ($rel) {
            say color bright_yellow => "Skipped! Relative directory not specified"
                if $self->debugmode;
            next;
        }
        my $dir = File::Spec->rel2abs($rel, $self->datadir);
        my $url = $rec->{url};
        unless ($url) {
            say color bright_yellow => "Skipped! Repo URL not specified for \"%s\"", $dir
                if $self->debugmode;
            next;
        }
        my $rule = $rec->{rule};
        unless ($rule) {
            say color bright_yellow => "Skipped! Rule not specified for \"%s\"", $dir
                if $self->debugmode;
            next;
        }
        my $sign = isnt_void(VCS()->{$rule}) ? VCS()->{$rule}{fs_sign} : undef;
        unless ($sign) {
            say color(bright_yellow => "%s → %s", "SKP", $dir);
            say color bright_yellow => "%sThis is custom project", " "x6 if $self->debugmode;
            next;
        }
        if ($rule eq 'noop') {  # SKIP
            say color(bright_yellow => "%s → %s", "SKP", $dir);
            say color bright_yellow => "%sThis is custom project", " "x6 if $self->debugmode;
            next;
        }

        # Check project
        if (-e File::Spec->catdir($dir, $sign)) {
            say color(bright_yellow => "%s → %s", "SKP", $dir);
            say color bright_yellow => "%sThe project already exists", " "x6 if $self->debugmode;
            next;
        }

        # Get checkput command as array
        my $checkout = VCS()->{$rule}{checkout} || '';
        unless (length $checkout) {
            say color(bright_yellow => "%s → %s", "SKP", $dir);
            say color bright_yellow => "%sNo `checkout` command found. Maybe this is custom project?", " "x6
                if $self->debugmode;
            next;
        }
        my @cmd = ();
        foreach my $w (shellwords($checkout)) {
            push @cmd, dformat($w, {
                URL => $url,
                DIR => $dir,
            });
        }

        # Ok
        say color(bright_cyan => "%s → %s [%s]", uc($rule), $dir, $url);

        # Prepare dirs
        make_path($dir);
        unless (-d $dir) {
            say color "bright_red" => "Can't prepare directory \"%s\": %s", $dir, $!;
            next;
        }

        # Execute cmd
        printf "# %s\n", join(" ", @cmd) if $self->debugmode; # no color
        my $res = $self->execmd([@cmd]);
        if ($res->{status}) {
            say $res->{out} if length $res->{out} && $self->verbosemode; # no color
        } else {
            say color "bright_red" => "%s", $res->{err} // 'Unknown error'; # red
            say $res->{out} if length($res->{out}) && $self->verbosemode; # no color
        }
    }

    return 1;
}
sub execmd {
    my $self = shift;
    my $cmd = shift || [];
    my $cmd_str = '';
    if (is_array_ref($cmd)) {
        $cmd_str = join " ", @$cmd;
    } else {
        $cmd_str = $cmd;
        $cmd = [$cmd];
    }
    return {
        command => 'noop',
        status  => 1,
        err_msg => '',
        err     => '',
        out     => '',
    } if !length($cmd_str) || $cmd_str eq 'noop';
    my ($ok, $err_msg, $full_buf, $stdout_buf, $stderr_buf) =
        IPC::Cmd::run(
            command => [@$cmd],
            verbose => 0, # $self->debugmode,
            timeout => UPDATER_TIMEOUT,
        );
    $err_msg //= '';
    chomp($err_msg) if length $err_msg;
    unshift @$stderr_buf, $err_msg if length $err_msg;
    my $out = join("\n", @$stdout_buf) // ''; chomp $out;
    my $err = join("\n", @$stderr_buf) // ''; chomp $err;
    return {
        command => $cmd_str,
        status  => $ok ? 1 : 0,
        err_msg => $err_msg,
        out     => $out,
        err     => $err,
    };
}

sub init_makefile {
    my $self = shift;
    my $force = shift;

    # Get maker and makefile path
    my $maker = is_os_type('Windows') ? 'dmake' : 'make';
    my $makefile = File::Spec->catfile($self->datadir, MAKEFILE);
    return 1 if (!$force && -e $makefile); # skip if file already exists and no forced mode
    say STDERR color white => "Warning! The makefile already exists" if -e $makefile;

    # Switch work directory
    my $orig_dir = getcwd; # Real current directory
    chdir $self->datadir; # To datadir

    # init
    @ExtUtils::MakeMaker::MM_Sections = qw(
        post_initialize
        const_config constants
        tools_other
        dist macro
        post_constants
        postamble
    );
    WriteMakefile(
        'NAME'              => PROJECTNAME,
        'DISTNAME'          => PROJECTNAMEL,
        'MIN_PERL_VERSION'  => 5.020001,
        'VERSION'           => $self->VERSION,
        'ABSTRACT'          => "Updater. For internal use only",
        'AUTHOR'            => 'Sergey Lepenkov (Serz Minus) <abalama@cpan.org>',
        'LICENSE'           => 'perl',
        'NO_META'           => 1,
        'NO_MYMETA'         => 1,
        'DIR'               => [],
        macro => {
            PROJECT         => PROJECTNAMEL,
            MYROOT          => $self->datadir,
        },
    );
    if ($self->verbosemode && -e $makefile) {
        say color bright_green => "The Makefile \"%s\" has been successfully created", $makefile;
        say color bright_green => "You can use next time:";
        say color bright_green => "  cd %s", $self->datadir;
        say color bright_green => "  %s update", $maker;
    }

    # Go to my dir
    chdir($orig_dir);
    return 1
}

#
# ExtUtils::MakeMaker MY methods
#

# Set constants
sub MY::post_initialize {
my $section = <<'MAKE_FRAG';
DATE_CREATE = [DATE_CREATE]
MAKE_FRAG
return dformat($section, {
        DATE_CREATE => dtf("%YYYY-%MM-%DD %hh:%mm:%ss", time()),
    });
}

# Calculated constants
sub MY::post_constants {
my $section = <<'MAKE_FRAG';
PRJPATH     = [PRJPATH]
PRJFLAGS    = -s
UPDATER     = $(PERLRUN) $(PRJPATH) $(PRJFLAGS)
MAKE_FRAG
return dformat($section, {
        PRJPATH => File::Spec->catfile($RealBin, $RealScript),
    });
}

# SubSections (postamble)
sub MY::postamble {
my $section = <<'MAKE_FRAG';

.PHONY: [PHONY]
[USESHELL]

all :: usage

#
# Update
#

update : $(PROJECT).tmp
[CMD]- $(NOECHO) $(RM_F) $(PROJECT).tmp
[CMD]$(NOECHO) $(ECHO) Done.

$(PROJECT).tmp :
[CMD]$(NOECHO) $(ECHO) "Start Update process..."
[CMD]$(UPDATER) update
[CMD]$(NOECHO) $(TOUCH) $(PROJECT).tmp

up : update
[CMD]$(NOECHO) $(NOOP)

#
# List
#

list :
[CMD]$(UPDATER) --list

ls : list
[CMD]$(NOECHO) $(NOOP)

#
# Clean
#

clean purge ::
[CMD]- $(RM_F) \
[CMD]MYMETA.json \
[CMD]MYMETA.yml
[CMD]- $(RM_F) $(PROJECT).yml $(PROJECT).pid
[CMD]- $(RM_RF) \
[CMD]*.bak *.tmp
[CMD]$(NOECHO) $(RM_F) $(FIRST_MAKEFILE)

#
# Usage
#

usage :
[CMD]$(NOECHO) $(ECHO) "Usage:"
[CMD]$(NOECHO) $(ECHO) "    cd $(MYROOT)"
[CMD]$(NOECHO) $(ECHO) "    $(PRJPATH)"
[CMD]$(NOECHO) $(ECHO) "    make ls"
[CMD]$(NOECHO) $(ECHO) "    make update"
[CMD]$(NOECHO) $(ECHO) "    make clean"

help : usage
[CMD]$(UPDATER) --longhelp

MAKE_FRAG
return dformat($section, {
        PHONY     => join(" ", @{(PHONY())}),
        USESHELL  => (is_os_type('Windows') ? "\n.USESHELL:\n" : ""),
        TAB       => "\t",
        CMD       => "\t",
    });
}

1;

__END__
