view release on metacpan or  search on metacpan

lib/App/RepoSync/Export.pm  view on Meta::CPAN

package App::RepoSync::Export;
use 5.10.0;
use warnings;
use strict;
use Cwd qw(realpath getcwd);
use YAML;
use JSON;
use File::Spec;
use File::Find::Rule;
use File::Basename;
use Config::Tiny;
use App::RepoSync::SystemUtil qw(system_or_die chdir_qx);
use Term::ANSIColor;

sub parse_svn_info {
    my $cmd = shift || 'svn info';
    my $info;
    unless( $info = qx(LC_ALL=C $cmd 2> /dev/null ) ) {
        say 'svn: info failed: ' . getcwd;

        # if uprade is needed,
        my $ret = qx(LC_ALL=C $cmd 2>&1);
        if ($cmd eq 'svn info' && $ret =~ /svn upgrade/) {
            say "svn: try upgrading: " . getcwd;
            system_or_die('svn upgrade 2>&1 > /dev/null');
        }
    }

    unless( $info = qx(LC_ALL=C $cmd 2> /dev/null ) ) {
        say "svn: info still failed: " . getcwd;
        return;
    }

    my ($url) = ($info =~ m{URL: (\S+)});
    my ($revision) = ($info =~ m{Revision: (\S+)});
    return { 
        url      => $url,
        revision => $revision,
    };
}

sub traverse_dir {
    my ($dir,$cb) = @_;

    opendir(my $dh, $dir ) || die "can't opendir $dir: $!";

    my @result;
    my @dirs = readdir($dh);
    closedir $dh;
    for my $subdir ( @dirs ) {
        my $abspath = File::Spec->join( $dir, $subdir );
        next if $subdir eq '.' || $subdir eq '..' ;

        if( -d $abspath ) {
            my $path = $cb->( $subdir, $dir );

            next if $path && $path == -1;

            if( $path ) {
                push @result, $path;
            } else {
                push @result, traverse_dir( $abspath , $cb);
            }
        }
    }
    return @result;
}

sub run {
    my ($class,$export_root) = @_;
    my $sync_root = getcwd();

    $export_root = realpath( $export_root );

    my @repos = traverse_dir $export_root, sub { 
        my ($subdir,$parent) = @_;
        my $path = File::Spec->join( $parent, $subdir );
        my $subpath = substr( $path , length( $sync_root ) + 1 );

        return if $subdir =~ /^\./; # do not descent
        return if ! -d $path;
        if( -d File::Spec->join( $path, '.svn' ) ) {

            chdir $path;
            my $info = parse_svn_info;
            unless( $info ) {
                chdir $sync_root;
                return -1;
            }