#!perl -w
# (C) 2003-2007 Willem Jan Hengeveld <itsme@xs4all.nl>
# Web: http://www.xs4all.nl/~itsme/
#      http://wiki.xda-developers.com/
#
# $Id$
#
use strict;
use warnings;
use Getopt::Long;

my $g_sortbyname= grep { $_ eq "-n" } @ARGV;
# bugs:  path is represented incorrectly:  ui/ce/ui/ce/....
#         instead of  ui/ce/....

$|=1;
my @records;
my %repositorymap;
my $curpath= "";
my $cur;
my $log;
my $state= 0;
# 0 = expecting empty line
# 1 = getting file attribs
# 2 = expecting ---- or ====, getting comments
# 3 = expecting revision line
# 4 = expecting date line

sub shellescape {
    my $arg= shift;
    # ?? what do I escape for windows shell?
    return $arg;
}
my $cmdline= join(" ", map { '"'.shellescape($_).'"' } grep { $_ ne "-n" } @ARGV);

open CVS, "cvs log $cmdline 2>&1 |" or die "running cvs log: $!\n";
while (<CVS>) {
    if ($state==0 && /^\?\s*(.*)/) {
        my $fn=$1;

        if (-d $fn) {
            push @records, {
                fullpath=> "$fn/",
                status=> "NEWDIR",
            };
        }
        elsif (-f $fn) {
            push @records, {
                fullpath=> $fn,
                status=> "NEWFILE",
            };
        }
        else {
            warn("WARNING: unexpected: $_\n");
        }
    }
    elsif ($state==0 && /^$/) {
        $state = 1;
    }
    elsif ($state==1 && /^(.*?):\s*(.*)/) {
        my ($name, $value)= ($1, $2);
        if (exists $cur->{$name}) {
            warn "WARNING: did not expect $name to already exist\n";
        }
        if ($name eq "Working file") {
            $cur->{fullpath}= "$value";
        }
        elsif ($name eq "description") {
            $state= 2;
        }
        $cur->{$name}= $value;
    }
    elsif ($state==2 && /^----------------------------$/) {
        if ($log) {
            push @{$cur->{logs}}, $log;
        }
        $log= undef;
        $state= 3;
    }
    elsif ($state==2 && /^=============================================================================$/) {
        my $rcsfile= $cur->{'RCS file'};
        my $workfile= $cur->{'Working file'};
        if ($rcsfile =~ s/\/Attic\//\//) {
            $cur->{in_attic}= 1;
        }

        my $i= index($rcsfile, $workfile);
        if ($i==-1) {
            warn "WARNING: path and repository file don't match:\n    repository file: $rcsfile\n    path: $workfile\n";
        }
        else {
            $repositorymap{substr($cur->{'RCS file'},0,$i)}++;
        }
        if ($log) {
            push @{$cur->{logs}}, $log;
        }

        push @records, $cur;

        $log= undef;
        $cur= undef;

        $state= 0;
    }
    elsif ($state==2 || ($state==4 && !/\w:.*;/)) {
        push @{$log->{comments}}, $_;
        $state= 2;
    }
    elsif ($state==3 && /^revision\s*(.*)/) {
        $log->{revision}= $1;
        $state= 4;
    }
    elsif ($state==4 && /\w:.*;/) {
        my $attrlist= $_;
        for (split(/;\s+/, $attrlist)) {
            if (/(\w+):\s(.*)/) {
                my ($key, $val)= ($1, $2);

                if (exists $log->{$key}) {
                    warn "WARNING: did not expect log to have duplicate $key\n";
                }
                $log->{$key}= $val;
            }
            elsif (/Initial revision/) {
                $log->{$_}=1;
            }
            else {
                warn "WARNING: unexpected string in log entry kv list: $_\n";
            }
        }
    }
    elsif ($state==0 && /^cvs log: Logging (.*)/) {
        $curpath= "$1/";
        if ($curpath eq "./") {
            $curpath= "";
        }
    }
    elsif ($state==0 && /^cvs log: (.*) has been added, but not committed/) {
        push @records, {
            fullpath=> "$curpath/$1",
            status=> "UNCOMMITTED",
        };
    }
    else {
        warn "WARNING: unrecognized line in state $state: $_\n";
    }
}
close CVS;
print map { sprintf("found %d files in repository %s\n", $repositorymap{$_}, $_); } keys %repositorymap;

print_specialstate();
print_normal();
print_attic();

exit(0);

sub print_specialstate {
    for (sort { $a->{status} cmp $b->{status} || $a->{fullpath} cmp $b->{fullpath} } grep { $_->{status} } @records) {
        printf("%s  %s\n", $_->{status}, $_->{fullpath});
    }
}
sub print_normal {
    my @comments;
    for my $rec (grep { !$_->{status} && !$_->{in_attic} } @records)
    {
        for my $log (@{$rec->{logs}})
        {
            push @comments, {
                date=>$log->{date},
                fullpath=>$rec->{fullpath},
                author=>$log->{author},
                comments=>$log->{comments},
                revision=>$log->{revision},
            };
        }
    }
    for my $cmt (sort { ordering($a, $b) } @comments)
    {
        printf("%s %s %s %s\n", $cmt->{date}, $cmt->{revision}, $cmt->{author}, $cmt->{fullpath});
        if ($cmt->{comments}) {
            print map { "    $_\n" } @{$cmt->{comments}};
        }
    }
}
sub ordering {
    my ($a, $b)= @_;
    if ($g_sortbyname) 
    {
        return $a->{fullpath} cmp $b->{fullpath} || $b->{date} cmp $a->{date};
    }
    else
    {
        return $b->{date} cmp $a->{date} || $a->{fullpath} cmp $b->{fullpath};
    }

}
sub print_attic {
    my @comments;
    for my $rec (grep { !$_->{status} && $_->{in_attic} } @records)
    {
        for my $log (@{$rec->{logs}})
        {
            push @comments, {
                date=>$log->{date},
                fullpath=>$rec->{fullpath},
                author=>$log->{author},
                comments=>$log->{comments},
            };
        }
    }
    for my $cmt (sort { $b->{date} cmp $a->{date} || $a->{fullpath} cmp $b->{fullpath} } @comments)
    {
        printf("ATTIC: %s %s %s\n", $cmt->{date}, $cmt->{author}, $cmt->{fullpath});
        if ($cmt->{comments}) {
            print map { "    $_\n" } @{$cmt->{comments}};
        }
    }
}
