File Coverage

blib/lib/VCS/Hms.pm

Criterion	Covered	Total	%
statement	15	48	31.2
branch	0	6	0.0
condition			n/a
subroutine	5	10	50.0
pod			n/a
total	20	64	31.2

package VCS::Hms;

use strict;
use vars qw($VERSION);
use VCS::Hms::Dir;
use VCS::Hms::File;
use VCS::Hms::Version;

$VERSION = '0.04';

my $LOG_CMD = "fhist";

my %LOG_CACHE;

sub _boiler_plate_info {
    my ($self, $what) = @_;
    my ($header, $log) = $self->_split_log($self->version);
    my $rev_info = $self->_parse_log_rev($log);
    $rev_info->{$what};
}

sub _split_log {
    my ($self, $version) = @_;
    my $log_text;

    my $cache_id = $self->path . '/' . defined $version ? $version : 'all';
    unless (defined($log_text = $LOG_CACHE{$cache_id})) {
        my $cmd =
            $LOG_CMD .
            (defined $version ? " -r$version" : '') .
            " " . $self->path . " |";
        $LOG_CACHE{$cache_id} = $log_text = $self->_read_pipe($cmd);
    }
    my @sections = split /\n[=\-]+\n/, $log_text;
    #map { print "SEC: $_\n" } @sections;
    @sections;
}

sub _parse_log_rev {
    my ($self, $text) = @_;
    my ($rev_line, $blurb, $blurb2, @reason) = split /\n/, $text;
    my %info = map {
        split /:\s+/,2
    } split /;\s*/, $blurb.$blurb2,;
    my ($junk, $rev) = split /\s+/, $rev_line;
    $info{'revision'} = $rev;
    $info{'reason'} = \@reason;
    #print "REASON: @reason\n";
    #map { print "$_ => $info{$_}\n" } keys %info;
    \%info;
}

sub _parse_log_header {
    my ($self, $text) = @_;
    my @parts = $text =~ /^(\S.*?)(?=^\S|\Z)/gms;
    chomp @parts;
    #map { print "PART: $_\n" } @parts;
    my %info = map {
        split /:\s*/, $_, 2
    } @parts;
    #map { print "$_ => $info{$_}\n" } keys %info;
    \%info;
}

sub _read_pipe {
    my ($self, $cmd) = @_;
    local *PIPE;
    #print "Pipe : $cmd\n";
    open PIPE, $cmd;
    local $/ = undef;
    my $contents = ;
    close PIPE;
    return $contents;
}

1;

=head1 NAME

VCS::Hms - notes for the HMS implementation

=head1 IMPORTANT NOTE

I have no way to test this module and so I have removed it out of
the main VCS distribution. If you have access to Hms and would like
to maintain this module please contact me - [e-mail].


=head1 SYNOPSIS

    use VCS;
    $file = VCS::File->new('Makefile');

=head1 DESCRIPTION

Currently, the user needs to ensure that their environment has the
HMS toolset available, including B, B, B, et al.
On Unix like environments ensure that the C<$PATH> environment variable
has the appropriate directory listed.

=head1 COPYRIGHT

    Copyright (c) 2003-2008 Greg McCarroll.
    Copyright (c) 1998-2001 Leon Brocard.

All rights reserved. This program is free software; you can
redistribute it and/or modify it under the same terms as Perl itself.

=head1 SEE ALSO

L.

=cut