updater/lib/App/Updater.pm
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__