The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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;
            }

            my ($name) = basename($path);
            my ($url) = ($info =~ m{URL: (\S+)});
            my ($revision) = ($info =~ m{Revision: (\S+)});
            chdir $sync_root;
            return { 
                type => 'svn',
                path => $subpath,
                name => $name,
                %$info,
            };
        }
        elsif( -d File::Spec->join( $path , '.git' ) ) {
            chdir $path;
            my $remote_string = qx(git remote -v 2> /dev/null);

            unless( $remote_string ) {
                # try to fetch .git/refs/remotes/git-svn
                if( -e File::Spec->join( $path, '.git', 'refs','remotes', 'git-svn' ) ) {
                    my $info = parse_svn_info 'git svn info';
                    chdir $sync_root;
                    return { 
                        type => 'git-svn',
                        %$info,
                    };
                }
            }

            my %remotes = map { 
                        m{(\w+)\s+(\S+)\s+};
                        ($1 => $2);
                    } split /\n/,$remote_string;
            my $url = $remotes{origin};
            chdir $sync_root;
            return {
                type => 'git',
                path => $subpath,
                remotes => \%remotes,
                url => $url,
            };
        }
        elsif( -d File::Spec->join( $path , '.hg' ) ) {
            chdir $path;

            # try to read .hg/hgrc
            my $config_path = File::Spec->join( $path, '.hg', 'hgrc' );
            my $cfg = Config::Tiny->read($config_path);
            my $paths = $cfg->{paths};
            my $branch = qx(hg branch);
            chomp( $branch );
            chdir $sync_root;
            return {
                type     => 'hg',
                path     => $subpath,
                url      => $paths->{default} || $paths->{'default-push'},
                branch   => $branch,
                remotes  => $paths,
            };
        }
        return;
    };

    return @repos;
}

1;