#!/usr/bin/perl -w

=head1 NAME

    betas - поиск нужной беты

=head1 DESCRIPTION

    Usage:
    betas [DIR_RE [BRANCH_RE [FILE_RE]]] [-c] [-m|-mm|-mmm] [-d]

    Скрипт ищет директории в /var/www/, соответсвующие указанным критериям:
      DIR_RE - директория матчится указанным регэкспом
      BRANCH_RE - выкаченный бранч матчится указанным регэкспом
      FILE_RE - на бете есть локально-модифицированный файл, который матчится указанным регэкспом
      -c - на бете нет локально-модифиуированных файлов
      
    Опции вывода:
      -d вывести только первую директорию
      -m вывести краткую статистику по локальным модификациям
      -mm - вывести подробную статистику - с именами файлов
      -mmm - ещё более подробную - с временем модификации
      -nh - не выводить заголовок, только файлы
    
=head1 SYNOPSIS

    Примеры использования:
    
    # все мои беты
    betas `whoami`

    # все мои "чистые" беты
    betas zhur -c

    # все мои транковые беты
    betas zhur trunk
    
    # все нетранковые беты
    betas . '^(?!.*trunk)'
    
    # беты пользователя zhur, в которых есть изменённый TTTools
    betas zhur . TT
    
    # список бет с изменёнными файлами (краткая статистика)
    betas mirage -m
    
    # список бет с изменёнными файлами (расширенная информация)
    betas sergeysl -mm

=cut

use strict;
use POSIX qw/strftime/;

my $MOD = grep {/^-+m/} @ARGV;
my $EXTMOD = grep {/^-+mm/} @ARGV;
my $TIMES = grep {/^-+mmm/} @ARGV;

my $DIR_ONLY = grep {/^-+d/} @ARGV;
my $CLEAR = grep {/^-+c/} @ARGV;
my $NO_HEADER = grep {/^-+nh/} @ARGV;

@ARGV = grep {!/^-/} @ARGV;
my ($re, $branch_re, $file_re) = map {!defined $_ || $_ eq '.' ? '' : $_} @ARGV[0..2];

my $base = '/var/www';
opendir(D, $base) || die "Can't read dir $base";
my $euser = getpwuid($>);
my @dirs = 
        # пересортировываем, чтобы свои беты оказались первыми
        map {s/^.//; $_} sort map {(/$euser/ ? '0' : '1').$_}
        grep {-d}
        map {"$base/$_"}
        grep {/$re/}
        grep {/^[\w\.\-]+$/}
        readdir(D);
for my $dir (@dirs) {
    my $text = `LC_ALL=C svn info $dir 2>&1`;
    my ($url) = $text =~ /^URL:\s+(.*)/m;
    my ($rev) = $text =~ /^Revision:\s+(.*)/m;
    next if $branch_re && (!$url || $url !~ /$branch_re/);
    if ($url && $rev) {
        $url =~ s/^(?:https|svn\+ssh):\/\/svn.yandex.ru\///;
        my (@lines, @stat);
        my $file_re_flag = 0;
        my $clear_flag = 0;
        if ($MOD || $file_re || $CLEAR) {
            my @text = `LC_ALL=C svn st -q $dir`;
            my @modified = map {s/$dir\///;$_} map {[split /\s+/]->[-1]} grep {/^M\s/} @text;
            my @conflicted = map {s/$dir\///;$_} map {[split /\s+/]->[-1]} grep {/^C\s/} @text;
            my @added = map {s/$dir\///;$_} map {[split /\s+/]->[-1]} grep {/^A\s/} @text;
            my @deleted = map {s/$dir\///;$_} map {[split /\s+/]->[-1]} grep {/^D\s/} @text;
            my @all = (@modified, @added, @conflicted, @deleted);
            $file_re_flag = 1 if $file_re && grep {/$file_re/} @all;
            $clear_flag = !@all;
            if (@all) {
                if (@modified) {push @stat, "modified: ".scalar(@modified);}
                if (@added) {push @stat, "added: ".scalar(@added);}
                if (@conflicted) {push @stat, "conflicts: ".scalar(@conflicted);}
                if (@deleted) {push @stat, "deleted: ".scalar(@deleted);}
            }
            if ($EXTMOD) {
                push @lines, map {($NO_HEADER ? '' : "\t")."A ".file_times("$dir/$_")." $_"} @added;
                push @lines, map {($NO_HEADER ? '' : "\t")."M ".file_times("$dir/$_")." $_"} @modified;
                push @lines, map {($NO_HEADER ? '' : "\t")."C ".file_times("$dir/$_")." $_"} @conflicted;
                push @lines, map {($NO_HEADER ? '' : "\t")."D ".file_times("$dir/$_")." $_"} @deleted;
            }
        }
        if ((!$file_re || $file_re_flag) && (!$CLEAR || $clear_flag)) {
            if ($DIR_ONLY) {
                print "$dir\n";
                exit 0;
            } else {
                if (!$NO_HEADER) {
                    my $conf = get_conf($dir);
                    my $dna = get_dna($dir);
                    unshift @lines, "$dir  r$rev  $url $dna $conf".(@stat ? " (".join(', ', @stat).")" : '');
                }
                print map {"$_\n"} @lines;
            }
        }
    }
}
if ($DIR_ONLY) {
    die "Can't find specified directory";
}

sub file_times {
    my ($fname) = @_;
    if ($TIMES) {
        return " ".strftime("%Y-%m-%d:%H:%M", localtime( (stat $fname)[9] ))." ";
    } else {
        return '';
    }
}

sub get_conf {
    my ($dir) = @_;
    my $ls = `ls -l $dir/perl/settings/SettingsLocal.pm 2>/dev/null`;
    # если симлинка нет - это продакшеновый конфиг
    return "production"  if !$ls;

    $ls =~ /SettingsLocal\.pm.*Settings([^.]+)\.pm/;
    my $conf = defined $1 ? lc $1 : 'unknown_conf';
    return $conf;
}

sub get_dna {
    my ($dir) = @_;
    my $arc_head_file = "$dir/dna_arc_store/.arc/HEAD";

    if ( -f $arc_head_file ) {
        my $branch;

        eval {
            my $arc_head_content = `cat $arc_head_file 2>/dev/null`;

            if ($arc_head_content =~ m/\:\s"(.+)"$/) {
                $branch = $1;
            }
        };

        if ($branch && !$@) {
            return " DNA:$branch";
        }
    }

    return '';
}

