File: Version.pm

package info (click to toggle)
libvcs-perl 0.14-3
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 264 kB
  • ctags: 282
  • sloc: perl: 1,083; makefile: 567
file content (74 lines) | stat: -rw-r--r-- 1,747 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
package VCS::Cvs::Version;

@ISA = qw(VCS::Cvs VCS::Version);

use File::Basename;

my $DIFF_CMD = "cvs -Q diff -u";
my $UPDATE_CMD = "cvs -Q update -p";

sub new {
    my ($class, $url) = @_;
    my $self = $class->init($url);
    my $path = $self->path;
    die "$class->new: $path: $!\n" unless -f $path;
    die "$class->new: $path not in a CVS directory: $!\n"
        unless -d dirname($path) . '/CVS';
    $self;
}

sub tags {
    my $self = shift;
    my ($header, $log) = $self->_split_log($self->{VERSION});
    my $header_info = $self->_parse_log_header($header);
    my %rev2tags;
    my $tag_text = $header_info->{'symbolic names'};
#warn "t_t: $tag_text\n";
    $tag_text =~ s#^\s+##gm;
#warn "t_t2: $tag_text\n";
#    return () unless defined ($rev2tags{$self->{VERSION}});
    map {
        my ($tag, $rev) = split /:\s*/;
        push @{$rev2tags{$rev}}, $tag;
    } split /\n/, $tag_text;
    @{ $rev2tags{$self->{VERSION}} || [] };
}

sub text {
    my $self = shift;
    $self->_read_pipe(
        "$UPDATE_CMD -r$self->{VERSION} '$self->{NAME}' |"
    );
}

sub diff {
    my $self = shift;
    my $other = shift;
#print "$self -> $other\n";
    my $text = '';
    if (ref($other) eq ref($self)) {
        my $cmd =
	    'chdir ' . dirname($self->path) .
            " && $DIFF_CMD " .
            join (' ', (map { "-r$_" } $self->version, $other->version)) .
            " '" . basename($self->path) . "' |";
        $text = $self->_read_pipe($cmd);
        $text =~ s#.*^diff.*?\n##ms;
#print "cmd: $cmd gave $text\n";
    }
    $text;
}

sub author {
    shift->_boiler_plate_info('author');
}

sub date {
    shift->_boiler_plate_info('date');
}

sub reason {
    join "\n", @{shift->_boiler_plate_info('reason')};
}

1;