view release on metacpan or  search on metacpan

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

    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(
                    {   action => 'D',
                        path   => "$dir$_",
                    }
                    ) for split( /\s+/, $files );
            }
            redo;
        }
        last if $line =~ /^Log Message/;
    }

    while(defined(my $line = <>)) {
        $log .= $line;
    }

    my $root = $self->cvs_root;
    $log =~ s{$root/}{} if $log;

    print MERGE "$_\n" for @changes;

    unless ($first_dir_in_commit) {
        close(MERGE);
        return undef;
    }

    return if fork();   # parent process exits

    #warn "$$ waiting\n";
    # wait for the merge file to settle
    while( time() - (stat(MERGE))[9] < 3 ) {
        sleep(1);
    }

    close(MERGE);
    open(MERGE, $merge_file) or die "Error reopening $merge_file: $!\n";
    unlink $merge_file or warn "Error removing $merge_file: $!\n";

    @changes = ();

    while ( defined( my $line = <MERGE> ) ) {
        chomp($line);
        push @changes, App::KGB::Change->new($line);
    }
    close(MERGE);

    $self->_called(1);

    return App::KGB::Commit->new(
        {   changes     => \@changes,
            author      => $self->author,
            author_name => $self->_get_full_user_name( $self->author ),
            log         => $log,
            module      => $module,
        }
    );
}

1;