#!/usr/bin/perl -w

=head1 NAME

Cvsinfo - retrieve CVS related informations from a checked out copy

=head1 SYNOPSIS

 use Cvsinfo;
 my $cvs = new Cvsinfo;
 $cvs->options({ verbose => 0, skipdir => [ 'aux' ] });
 $cvs->readinfo('.', { recursive => 1, verbose => 1 });
 my $rev = $cvs->revision('foo/bar');

=head1 DESCRIPTION

This module retrieves CVS related informations from a checked out
working directory, by scanning the F<CVS/Entries> files found within.

=head1 METHODS

=over 4

=cut

package Cvsinfo;
use Carp;
use strict;

=item new

This is the constructor.

   my $cvs = new Cvsinfo;

=cut

sub new {
        my $proto = shift;
        my $class = ref($proto) || $proto;
        my $self  = {
                IGNORE   => [],
                CWD      => '',
                DIRS     => [],
                FILES    => {},
                GLOBAL_OPTIONS => {},
                SKIP     => sub {},
        };
        bless ($self, $class);
        return $self;
}

=item options

Without arguments, returns a hash array containing the list of options.
If there is an argument, sets some global options for the timelife of
this object.  Argument is a reference to a hash array, currently
C<recursive>, C<verbose>, C<skipdir> and C<matchfile> keys are
recognized.  Processing is recursive (resp. verbose) if C<recursive>
(resp. C<verbose>) is set to a non-null value.  The C<skipdir> and
C<matchfile> values must be arrays containing Perl regular expressions,
the former specifies directory to skip in recursive mode (C<CVS>
directories are always skipped), and the latter specifies which files do
match (default: all).

   $cvs->options({recursive => 1, matchfile => [ '\.c$' ] });
   print join(' ', $cvs->options);

=cut

sub options {
        my $self = shift;
        if (!@_) {
                return %{$self->{GLOBAL_OPTIONS}};
        } elsif (ref($_[0]) ne "HASH") {
                croak "Argument of the Cvsinfo::options method must be a reference to a hash array\n";
        }
        $self->{GLOBAL_OPTIONS} = $_[0];
        $self->{GLOBAL_OPTIONS}->{matchfile} ||= [ '' ];
        $self->{OPTIONS} = $self->{GLOBAL_OPTIONS};
        $self->_fix_skip;
}

=item verbose

Display a message if C<verbose> option has been set by the C<options>
method.

   $cvs->verbose("Hey, I'm here!");

=cut

sub verbose {
        my $self = shift;
        return unless $self->{OPTIONS}->{verbose};
        print STDERR "Verbose:Cvsinfo: ".$_[0] . "\n";
}

=item readinfo

This is where processing is done.  First argument is a directory name,
the F<CVS/Entries> file will be searched in that directory and
informations on entries defined within are internally stored, unless
this entry has been discarded by an C<skipdir> attribute.
An optional second argument, if set to a reference to a hash array,
overrides global options.

   $cvs->readinfo("src");
   $cvs->readinfo("src", {recursive => 1});

=cut

sub readinfo {
        my $self    = shift;
        my $dir     = shift;
        my $options = shift;
        my @heredir = ();
        my ($entry, $oldoptions);

        $dir =~ s|/+$||;
        -r $dir."/CVS/Entries" or do {
                carp "Unable to read file $dir/CVS/Entries ...  skipped";
                return;
        };

        $oldoptions = $self->{OPTIONS};
        $self->{OPTIONS} = $self->{GLOBAL_OPTIONS};
        if (defined($options) && ref($options) eq "HASH") {
                foreach (keys %{$options}) {
                        $self->{OPTIONS}->{$_} = $options->{$_};
                }
        }
        $self->_fix_skip
                unless ref($oldoptions->{skipdir}) eq "ARRAY"
                and ref($oldoptions->{matchfile}) eq "ARRAY"
                and ref($self->{OPTIONS}->{skipdir}) eq "ARRAY"
                and ref($self->{OPTIONS}->{matchfile}) eq "ARRAY"
                and join("\n", $oldoptions->{skipdir}) eq join("\n", $self->{OPTIONS}->{skipdir})
                and join("\n", $oldoptions->{matchfile}) eq join("\n", $self->{OPTIONS}->{matchfile});

        open(ENTRIES, "< $dir/CVS/Entries")
                or croak "Unable to read file $dir/CVS/Entries\n";
        $self->verbose("Reading $dir/CVS/Entries");
        my @entries = <ENTRIES>;
        close(ENTRIES);
        #   Entries are sorted so that DIRS is also sorted.
        foreach (sort @entries) {
                chomp;
                if (m|^D/([^/]+)/|) {
                        $entry = $dir."/".$1;
                        next if $self->_skippable($entry);
                        push (@{$self->{DIRS}}, $entry);
                        push (@heredir, $entry);
                        $self->verbose("Found directory: $entry");
                } elsif (m|^/([^/]+)/([^/]+)/([^/]+)/([^/]*)/$|) {
                        $entry = $dir."/".$1;
                        next if $self->_skippable($entry);
                        $self->{FILES}->{$entry} = {
                                REV     => $2,
                                DATE    => $3,
                                KEYWORD => $4,
                        };
                        $self->verbose("Found file $entry, rev. $2, date $3");
                } elsif (m|^D$|) {
                        #  Hmmm, what is this entry for?
                } else {
                        carp "Unable to parse line:\n\t$_\n";
                }
        }
        return unless $self->{OPTIONS}->{recursive};
        foreach my $d (@heredir) {
                next if $self->_skippable($d);
                $self->readinfo($d, $options);
        }
}

#   Sets $self->{SKIP} according to $self->{OPTIONS}->{skipdir} and
#   $self->{OPTIONS}->{matchfile}
sub _fix_skip {
        my $self = shift;
        if (ref($self->{OPTIONS}) eq "HASH") {
                my $sub = "\$_ = shift; if (-d \$_) { return 1 if m{^(.*/)?CVS\$};";
                ref($self->{OPTIONS}->{skipdir}) eq "ARRAY" and do {
                        foreach (@{$self->{OPTIONS}->{skipdir}}) {
                                $sub .= "return 1 if m{$_};";
                        }
                };
                $sub .= "return 0; }";
                ref($self->{OPTIONS}->{matchfile}) eq "ARRAY" and do {
                        foreach (@{$self->{OPTIONS}->{matchfile}}) {
                                $sub .= "return 0 if m{$_};";
                        }
                };
                $sub .= "return 1";
                $self->{SKIP} = eval "sub {$sub}";
        } else {
                $self->{SKIP} = sub {};
        }
}

sub _skippable {
        my $self = shift;
        return 0 unless &{$self->{SKIP}}($_[0]);
        $self->verbose("Skipping $_[0]");
        return 1;
}

=item removefile

Removes an entry from the file list.

   $cvs->removefile("src/main.c");

=cut

sub removefile {
        my $self = shift;
        delete $self->{FILES}->{$_[0]};
}

=item dirs

Returns a reference to the list of directories contained in current
working directory.

   foreach (@{$cvs->dirs}) {
        print "Found directory: $_\n";
   }

=cut

sub dirs {
        my $self = shift;
        return $self->{DIRS};
}

=item files

Returns a reference to file list.

   foreach (@{$cvs->files}) {
        print "Found file: $_\n";
   }

=cut

sub files {
        my $self = shift;
        return [keys %{$self->{FILES}}];
}

=item revision

First argument is a filename.  If there is no more argument, the CVS
revision of this file is returned, otherwise it is set to the 2nd
argument.

   my $rev = $cvs->revision("src/foo.c");

=cut

sub revision {
        my $self = shift;
        my $file = shift;
        return undef if !defined($self->{FILES}->{$file});
        $self->{FILES}->{$file}->{REV} = $_[0] if @_;
        return $self->{FILES}->{$file}->{REV};
}

=item date

First argument is a filename.  If there is no more argument, the latest
commit date of this file is returned (in a format similar to the
C<date> command output), otherwise it is set to the 2nd argument.

   my $date = $cvs->date("src/foo.c");

=cut

sub date {
        my $self = shift;
        my $file = shift;
        return undef if !defined($self->{FILES}->{$file});
        $self->{FILES}->{$file}->{DATE} = $_[0] if @_;
        return $self->{FILES}->{$file}->{DATE};
}

=item keyword

First argument is a filename.  If there is no more argument, the keyword
substitution method (see the B<-k> flag of the C<cvs> command) for this
file is returned, otherwise it is set to the 2nd argument.

   my $kflag = $cvs->keyword("src/foo.c");

=cut

sub keyword {
        my $self = shift;
        my $file = shift;
        return undef if !defined($self->{FILES}->{$file});
        $self->{FILES}->{$file}->{KEYWORD} = $_[0] if @_;
        return $self->{FILES}->{$file}->{KEYWORD};
}

1;

=back

=cut