[devel] Gear и внешние VCS.

[Igor Vlasenko]

On Thu, Jun 19, 2014 at 10:46:26PM +0300, Igor Vlasenko wrote:
> On Thu, Jun 19, 2014 at 11:08:17PM +0400, Anton Farygin wrote:
> > >Достаточно ли
> > >>>пока поддерживает только стандартные теги v на version@ и @version@,
> > >?
> > нет, см. php5
> 
> Пока не определился с форматом .gear/upstream/tag-filter,
> прикрепляю новый test-tag-watch, для php5 запускать как
> 
> test-tag-watch --pattern 'php-([0-9\.]+)'
> 
> когда станет ясно содержимое .gear/upstream/tag-filter,
> php-([0-9\.]+) можно будет вписать туда.

забыл сам скрипт прикрепить - прикрепляю.

-- 

I V
----------- следующая часть -----------
#!/usr/bin/perl

use strict;
use warnings;
use RPM::uscan;
use Getopt::Long;

my $pattern='v?([\d\.]*\d)';
my $pkg_dir='.';
my $debug=0;
my ($verbose,$help);

my $result = GetOptions (
    'verbose+' => \$verbose,
    'q|quiet'  => sub {$verbose=0},
    'h|help'   => \$help,
    'pattern=s'   => \$pattern,
    );

$debug=1 if $verbose;
print "pattern=$pattern\n" if $debug;
print 'remotes=', join("\n",get_remotes($pkg_dir)),"\n" if $debug;
my @tags=get_tags();
die "no tags found that match pattern $pattern\n" unless @tags;
@tags = map {$_->[0]} Devscripts::Versort::upstream_versort(map {[$_,$_]}@tags);
print 'tags=', join(" ", на tags),"\n" if $debug;

my (undef, $upackage, $uversion) = RPM::uscan::altlinux_guess_package_and_version($pkg_dir);
my $version_cmp=Devscripts::Versort::myvercmp($uversion, $tags[0]);

if ($version_cmp>1) {
    print "Oops! local repository ($uversion) is ahead of remote repository ($tags[0]).\n";
} elsif ($version_cmp==0) {
    print "Repository is up to date.\n";
} else {
    print "New version $tags[0] is available.\n";
}

sub get_tags {
    my @tags;
    foreach my $remote (&get_remotes($pkg_dir)) {
	foreach my $tag (&exec2array('git ls-remote --tags '.$remote)) {
	    $tag=~s!^\S+\s+refs/tags/!!;
	    $tag=~s!\^\{\}$!!;
	    print "testing: $tag\n" if $debug;
	    push @tags, $1 if $tag=~/^$pattern$/;
	}
    }
    return @tags;
}

sub exec2array {
    my ($cmd)=@_;
    my @out;
    my $fn;
    open ($fn, "$cmd |") or die "$!: can't exec $cmd\n";
    local $_;
    while (<$fn>) {
	chomp;
	push @out, $_;
    }
    close ($fn);
    #print 'out=', join(";", на out),"\n";
    return @out;
}

sub get_remotes {
    my ($pkg_dir)=@_;
    my @remotes;
    die "can't find $pkg_dir/.gear/upstream/remotes\n" unless -r $pkg_dir.'/.gear/upstream/remotes';
    my $fn;
    open ($fn, 'git config --file '.$pkg_dir.'/.gear/upstream/remotes --list|') or die "$!: can't open .gear/upstream/remotes\n";
    local $_;
    while (<$fn>) {
	chomp;
	next unless /^remote\.([^\.]+)\.url=(\S+)/;
	my $remote=$1;
	#my $url=$2;
	push @remotes, $remote;
    }
    close ($fn);

    my %local_remotes=map{$_=>1} &exec2array('git remote');
    foreach my $remote (@remotes) {
	die "Oops: remote $remote is present in .gear/upstream/remotes, but not in .git/config!\n" unless $local_remotes{$remote};
    }
    return @remotes;
}