view release on metacpan or  search on metacpan

lib/App/KGB/Client/CVS.pm  view on Meta::CPAN

    $client->run;

=head1 DESCRIPTION

B<App::KGB::Client::CVS> provides CVS-specific retrieval of
commits and changes for L<App::KGB::Client>.

=head1 CONSTRUCTOR

=head2 B<new> ( { initializers } )

Standard constructor. Accepts inline hash with initial field values.

=head1 FIELDS

App:KGB::Client::CVS defines the following additional fields:

=over

=item B<cvs_root> (B<mandatory>)

Physical path to the CVS root directory.

=item B<author>

The user name of the commit author.

=item B<directory>

Relative (to CVS root) path to the directory this change is in.

As a convention, the first path member is taken as a module.

=back

=head1 METHODS

=over

=item describe_commit

The first time this method is called, it parses STDIN and determines commit
contents, returning an instance of L<App::KGB::Commit> class describing the
commit.

All subsequential invocations return B<undef>.

=back

=cut

require v5.10.0;
use base 'App::KGB::Client';
use App::KGB::Change;
use App::KGB::Commit;
use Carp qw(confess);
__PACKAGE__->mk_accessors(qw( _called author cvs_root directory ));

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->_called(0);

    defined( $self->cvs_root )
        or confess "'cvs_root' is mandatory";

    return $self;
}

use Fcntl qw(:flock);

sub describe_commit {
    my ($self) = @_;

    return undef if $self->_called;

    my $merge_file = File::Spec->catfile( $self->cvs_root, 'CVSROOT',
        sprintf( 'kgb-client-%d-%d.tmp', $<, getpgrp() ) );

    open(MERGE, ">>$merge_file") or die "Unable to open $merge_file: $!\n";

    my $first_dir_in_commit = flock( MERGE, LOCK_EX | LOCK_NB );

    my ( $tag, $log, @changes );
    # the first element is module, the rest - directory path
    my ($module, $dir) = $self->directory =~ m{([^/]+)(/.+)?};
    $dir //= '';
    $dir .= '/' if $dir;

    while ( defined( my $line = <> ) ) {
        $tag = $1, next if $line =~ /^\s*Tag: ([a-zA-Z0-9_-]+)/;

        if ( $line =~ /^Added Files:/ ) {
            while ( defined( $line = <> ) and $line =~ /^\s+(.+?)\s?$/ ) {
                my $files = $1;
                push @changes,
                    App::KGB::Change->new(
                    {   action => 'A',
                        path   => "$dir$_",
                    }
                    ) for split( /\s+/, $files );
            }
            redo;
        }
        if ( $line =~ /^Modified Files:/ ) {
            while ( defined( $line = <> ) and $line =~ /^\s+(.+?)\s?$/ ) {
                my $files = $1;
                push @changes,
                    App::KGB::Change->new(
                    {   action => 'M',
                        path   => "$dir$_",
                    }
                    ) for split( /\s+/, $files );
            }
            redo;
        }
        if ( $line =~ /^Removed Files:/ ) {
            while ( defined( $line = <> ) and $line =~ /^\s+(.+?)\s?$/ ) {
                my $files = $1;
                push @changes,
                    App::KGB::Change->new(