head	1.15;
access;
symbols
	0_07:1.14
	0_06:1.11
	0_05:1.10
	0_04:1.7.1.1
	0_03:1.7;
locks
	freter:1.14; strict;
comment	@# @;


1.15
date	98.08.29.04.58.42;	author freter;	state Exp;
branches;
next	1.14;

1.14
date	98.07.23.01.00.23;	author freter;	state Exp;
branches;
next	1.13;

1.13
date	98.07.15.01.27.11;	author freter;	state Exp;
branches;
next	1.12;

1.12
date	98.07.08.06.07.51;	author freter;	state Exp;
branches;
next	1.11;

1.11
date	98.07.05.18.29.06;	author freter;	state Exp;
branches;
next	1.10;

1.10
date	98.05.09.21.45.49;	author freter;	state Exp;
branches
	1.10.1.1;
next	1.9;

1.9
date	98.05.08.03.39.11;	author freter;	state Exp;
branches;
next	1.8;

1.8
date	98.03.07.19.51.02;	author freter;	state Exp;
branches;
next	1.7;

1.7
date	98.02.23.14.02.44;	author freter;	state Exp;
branches
	1.7.1.1;
next	1.6;

1.6
date	98.01.29.20.28.27;	author freter;	state Exp;
branches;
next	1.5;

1.5
date	98.01.10.03.09.43;	author freter;	state Exp;
branches;
next	1.4;

1.4
date	97.12.21.12.44.52;	author freter;	state Exp;
branches;
next	1.3;

1.3
date	97.12.21.12.36.51;	author freter;	state Exp;
branches;
next	1.2;

1.2
date	97.12.21.12.33.56;	author freter;	state Exp;
branches;
next	1.1;

1.1
date	97.12.21.12.29.49;	author freter;	state Exp;
branches;
next	;

1.7.1.1
date	98.03.08.01.12.35;	author freter;	state Exp;
branches;
next	;

1.10.1.1
date	98.07.05.21.57.29;	author freter;	state Exp;
branches;
next	;


desc
@Perl RCS Class Module
@


1.15
log
@Change class variables to object variables when modified by object method.
@
text
@package Rcs;
require 5.001;
use strict;
use Carp;
use Time::Local;
use vars qw($VERSION $revision);

#------------------------------------------------------------------
# global stuff
#------------------------------------------------------------------
$VERSION = '0.07';
$revision = '$Id: Rcs.pm,v 1.14 1998/07/23 01:00:23 freter Exp $';
my $Dir_Sep = ($^O eq 'MSWin32') ? '\\' : '/';
my $Exe_Ext = ($^O eq 'MSWin32') ? '.exe' : '';
my $Rcs_Bin_Dir = '/usr/local/bin';
my $Rcs_Dir = '.' . $Dir_Sep . 'RCS';
my $Work_Dir = '.';
my $Quiet = 1;    # RCS quiet mode
my $Arc_Ext = ',v';

#------------------------------------------------------------------
# RCS object constructor
#------------------------------------------------------------------
sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};

    # provide default values for system stuff
    $self->{"_BINDIR"}  = \$Rcs_Bin_Dir;
    $self->{"_QUIET"}   = \$Quiet;
    $self->{"_RCSDIR"}  = \$Rcs_Dir;
    $self->{"_WORKDIR"} = \$Work_Dir;
    $self->{"_ARCEXT"} =  \$Arc_Ext;

    $self->{FILE}       = undef;
    $self->{ARCFILE}    = undef;
    $self->{AUTHOR}     = undef;
    $self->{COMMENTS}   = undef;
    $self->{DATE}       = undef;
    $self->{LOCK}       = undef;
    $self->{ACCESS}     = [];
    $self->{REVISIONS}  = [];
    $self->{REVINFO}    = undef;
    $self->{STATE}      = undef;
    $self->{SYMBOLS}    = undef;
    bless($self, $class);
    return $self;
}

#------------------------------------------------------------------
# access
# Access list of archive file.
#------------------------------------------------------------------
sub access {
    my $self = shift;

    if (not @@{ $self->{ACCESS} }) {
        _parse_rcs_header($self);
    }

    # dereference revisions list
    my @@access = @@{ $self->{ACCESS} };

    return @@access;
}

#------------------------------------------------------------------
# arcext
# Set the RCS archive file extension (default is ',v').
#------------------------------------------------------------------
sub arcext {
    my $self = shift;

    # called as object method
    if (ref $self) {
        if (@@_) { $self->{"_ARCEXT"} = shift };
        return ref $self->{"_ARCEXT"} ? ${ $self->{"_ARCEXT"} } : $self->{"_ARCEXT"};
    }

    # called as class method
    else {
        if (@@_) { $Arc_Ext = shift; }
        return $Arc_Ext;
    }
}

#------------------------------------------------------------------
# arcfile
# Name of RCS archive file.
# If not set then return name of working file with RCS
# extension (',v').
#------------------------------------------------------------------
sub arcfile {
    my $self = shift;
    if (@@_) { $self->{ARCFILE} = shift }
    return $self->{ARCFILE} || $self->{FILE} . ${ $self->{"_ARCEXT"} };
}

#------------------------------------------------------------------
# author
# Return the author of an RCS revision.
# If revision is not provided, default to 'head' revision.
#------------------------------------------------------------------
sub author {
    my $self = shift;

    if (not defined $self->{AUTHOR}) {
        _parse_rcs_header($self);
    }
    my $revision = shift || $self->head;

    # dereference author hash
    my %author_array = %{ $self->{AUTHOR} };

    return $author_array{$revision};
}

#------------------------------------------------------------------
# bindir
# Set the bin directory in which the RCS distribution programs
# reside.
#------------------------------------------------------------------
sub bindir {
    my $self = shift;

    # called as object method
    if (ref $self) {
        if (@@_) { $self->{"_BINDIR"} = shift };
        return ref $self->{"_BINDIR"} ? ${ $self->{"_BINDIR"} } : $self->{"_BINDIR"};
    }

    # called as class method
    else {
        if (@@_) { $Rcs_Bin_Dir = shift };
        return $Rcs_Bin_Dir;
    }
}

#------------------------------------------------------------------
# ci
# Execute RCS 'ci' program.
# Make archive filename same as working filename unless
# specifically set.
#------------------------------------------------------------------
sub ci {
    my $self = shift;
    my @@param = @@_;

    my $ciprog = $self->bindir . $Dir_Sep . 'ci' . $Exe_Ext;
    my $rcsdir = $self->rcsdir;
    my $workdir = $self->workdir;
    my $file = $self->file;
    my $arcfile = $self->arcfile || $file;

    my $archive_file = $rcsdir . $Dir_Sep . $arcfile . $self->arcext;
    my $workfile = $workdir . $Dir_Sep . $file;
    push @@param, $archive_file, $workfile;
    unshift @@param, "-q" if $self->quiet;     # quiet mode

    # run program
    croak "ci program $ciprog not found" unless -e $ciprog;
    croak "ci program $ciprog not executable" unless -x $ciprog;
    system($ciprog, @@param) == 0 or croak "$!";

    # re-parse RCS file and clear comments hash
    _parse_rcs_header($self);
    $self->{COMMENTS} = undef;
}

#------------------------------------------------------------------
# co
# Execute RCS 'co' program.
# Make archive filename same as working filename unless
# specifically set.
#------------------------------------------------------------------
sub co {
    my $self = shift;
    my @@param = @@_;

    my $coprog = $self->bindir . $Dir_Sep . 'co' . $Exe_Ext;
    my $rcsdir = $self->rcsdir;
    my $workdir = $self->workdir;
    my $file = $self->file;
    my $arcfile = $self->arcfile || $file;

    my $archive_file = $rcsdir . $Dir_Sep . $arcfile . $self->arcext;
    my $workfile = $workdir . $Dir_Sep . $file;
    push @@param, $archive_file, $workfile;
    unshift @@param, "-q" if $self->quiet;     # quiet mode

    # run program
    croak "co program $coprog not found" unless -e $coprog;
    croak "co program $coprog not executable" unless -x $coprog;
    system($coprog, @@param) == 0 or croak "$!";

    # re-parse RCS file and clear comments hash
    _parse_rcs_header($self);
    $self->{COMMENTS} = undef;
}

#------------------------------------------------------------------
# comments
#------------------------------------------------------------------
sub comments {
    my $self = shift;

    if (not defined $self->{COMMENTS}) {
        _parse_rcs_body($self);
    }

    return %{$self->{COMMENTS}};
}

#------------------------------------------------------------------
# daterev
# Returns a revision which was current at a specified date/time.
# 0 is returned if all revisions are newer than the date 
# specified. This usually means the file did not exist on that
# date.
# This takes 6 parameters, year (4 digit year), month (1-12), day
# of month (1-31), hour (0-23), minute (0-59) and second (0-59).
#------------------------------------------------------------------
sub daterev {
    my $self = shift;
    my($year, $mon, $mday, $hour, $min, $sec) = @@_;

    # ensure date has all the elements
    if(@@_ != 6) {
        croak "daterev must have 6 element date/time (year, month, day, hour, min, sec)";
    }

    if($year !~ /^\d{4}$/) {
        croak "year (1st param) must be 4 digit number";
    }

    if (not defined $self->{DATE}) {
        _parse_rcs_header($self);
    }

    $mon--;        # convert to 0-11 range
    my $target_time = timegm($sec, $min, $hour, $mday, $mon, $year);
    my @@revisions;
    my %dates;

    my %dates_hash = %{$self->{DATE}};
    foreach $revision (keys %dates_hash) {
        my $date = $dates_hash{$revision};
        $dates{$date}{$revision} = 1;
    }

    my $date;
    foreach $date (reverse sort keys %dates) {
        foreach $revision (keys %{ $dates{$date} }) {
            push @@revisions, $revision if $date <= $target_time;
        }
    }

    return wantarray ? @@revisions : $revisions[0];
}

#------------------------------------------------------------------
# dates
# Return a hash of revision dates, keyed on revision, when called
# in list mode.
# Return the most recent date when called in scalar mode.
#
# RCS stores dates in GMT.
# The date values are system dates.
#------------------------------------------------------------------
sub dates {
    my $self = shift;

    if (not defined $self->{DATE}) {
        _parse_rcs_header($self);
    }

    my %DatesHash = %{$self->{DATE}};
    my @@dates_list = sort {$b<=>$a} values %DatesHash;
    my $MostRecent = $dates_list[0];

    return wantarray ? %DatesHash : $MostRecent;
}

#------------------------------------------------------------------
# file
# Name of working file.
#------------------------------------------------------------------
sub file {
    my $self = shift;
    if (@@_) { $self->{FILE} = shift }
    return $self->{FILE};
}

#------------------------------------------------------------------
# head
# Return the head revision.
#------------------------------------------------------------------
sub head {
    my $self = shift;

    if (not defined $self->{HEAD}) {
        _parse_rcs_header($self);
    }
    return $self->{HEAD};
}

#------------------------------------------------------------------
# lock
# Return user who has file locked.
#------------------------------------------------------------------
sub lock {
    my $self = shift;

    if (not defined $self->{LOCK}) {
        _parse_rcs_header($self);
    }
    return $self->{LOCK};
}

#------------------------------------------------------------------
# quiet
# Set or un-set RCS quiet mode.
#------------------------------------------------------------------
sub quiet {
    my $self = shift;

    # called as object method
    if (ref $self) {

        # set/un-set quiet mode
        if (@@_) {
            my $mode = shift;
            croak "Passed parameter must be either '0' or '1'"
                unless $mode == 0 or $mode == 1;
            $self->{"_QUIET"} = $mode;
            return ref $self->{"_QUIET"} ? ${ $self->{"_QUIET"} } : $self->{"_QUIET"};
        }

        # access quiet mode
        else {
            return ref $self->{"_QUIET"} ? ${ $self->{"_QUIET"} } : $self->{"_QUIET"};
        }
    }

    # called as class method
    else {

        # set/un-set quiet mode
        if (@@_) {
            my $mode = shift;
            croak "Passed parameter must be either '0' or '1'"
                unless $mode == 0 or $mode == 1;
            $Quiet = $mode;
            return $Quiet;
        }

        # access quiet mode
        else {
            return $Quiet;
        }
    }
}

#------------------------------------------------------------------
# rcs
# Execute RCS 'rcs' program.
# Make archive filename same as working filename unless
# specifically set.
#------------------------------------------------------------------
sub rcs {
    my $self = shift;
    my @@param = @@_;

    my $rcsprog = $self->bindir . $Dir_Sep . 'rcs' . $Exe_Ext;
    my $rcsdir = $self->rcsdir;
    my $workdir = $self->workdir;
    my $file = $self->file;
    my $arcfile = $self->arcfile || $file;

    my $archive_file = $rcsdir . $Dir_Sep . $arcfile . $self->arcext;
    my $workfile = $workdir . $Dir_Sep . $file;
    push @@param, $archive_file, $workfile;
    unshift @@param, "-q" if $self->quiet;     # quiet mode

    # run program
    croak "rcs program $rcsprog not found" unless -e $rcsprog;
    croak "rcs program $rcsprog not executable" unless -x $rcsprog;
    system($rcsprog, @@param) == 0 or croak "$?";

    # re-parse RCS file and clear comments hash
    _parse_rcs_header($self);
    $self->{COMMENTS} = undef;
}

#------------------------------------------------------------------
# rcsclean
# Execute RCS 'rcsclean' program.
#------------------------------------------------------------------
sub rcsclean {
    my $self = shift;
    my @@param = @@_;

    my $rcscleanprog = $self->bindir . $Dir_Sep . 'rcsclean' . $Exe_Ext;
    my $rcsdir = $self->rcsdir;
    my $workdir = $self->workdir;
    my $file = $self->file;
    my $arcfile = $self->arcfile || $file;

    my $archive_file = $rcsdir . $Dir_Sep . $arcfile . $self->arcext;
    my $workfile = $workdir . $Dir_Sep . $file;
    push @@param, $archive_file, $workfile;

    # run program
    croak "rcsclean program $rcscleanprog not found" unless -e $rcscleanprog;
    croak "rcsclean program $rcscleanprog not executable" unless -x $rcscleanprog;
    system($rcscleanprog, @@param) == 0 or croak "$?";

    # re-parse RCS file and clear comments hash
    _parse_rcs_header($self);
    $self->{COMMENTS} = undef;
}

#------------------------------------------------------------------
# rcsdiff
# Execute RCS 'rcsdiff' program.
# Calling in list context returns the output of rcsdiff, while
# calling in scalar context returns the return status of the
# rcsdiff program.
#------------------------------------------------------------------
sub rcsdiff {
    my $self = shift;
    my @@param = @@_;

    my $rcsdiff_prog = $self->bindir . $Dir_Sep . 'rcsdiff' . $Exe_Ext;
    my $rcsdir = $self->rcsdir;
    my $arcfile = $self->arcfile || $self->file;
    $arcfile = $rcsdir . $Dir_Sep . $arcfile . $self->arcext;
    my $workfile = $self->workdir . $Dir_Sep . $self->file;

    # un-taint parameter string
    unshift @@param, "-q" if $self->quiet;     # quiet mode
    my $param_str = join(' ', @@param);
    $param_str =~ s/([\w-]+)/$1/g;

    croak "rcsdiff program $rcsdiff_prog not found" unless -e $rcsdiff_prog;
    croak "rcsdiff program $rcsdiff_prog not executable" unless -x $rcsdiff_prog;
    open(DIFF, "$rcsdiff_prog $param_str $arcfile $workfile |");
    my @@diff_output = <DIFF>;

    # rcsdiff returns exit status 0 for no differences, 1 for differences,
    # and 2 for error condition.
    close DIFF;
    my $status = $?;
    croak "$rcsdiff_prog failed" if $status == 2;
    return wantarray ? @@diff_output : $status;
}

#------------------------------------------------------------------
# rcsdir
# Location of 'RCS' archive directory.
#------------------------------------------------------------------
sub rcsdir {
    my $self = shift;

    # called as object method
    if (ref $self) {
        if (@@_) { $self->{"_RCSDIR"} = shift }
        return ref $self->{"_RCSDIR"} ? ${ $self->{"_RCSDIR"} } : $self->{"_RCSDIR"};
    }

    # called as class method
    else {
        if (@@_) { $Rcs_Dir = shift }
        return $Rcs_Dir;
    }
}

#------------------------------------------------------------------
# revdate
# Return the revision date of an RCS revision.
# If revision is not provided, default to 'head' revision.
#
# RCS stores dates in GMT.  This method will return dates relative
# to the local time zone.
#------------------------------------------------------------------
sub revdate {
    my $self = shift;

    if (not defined $self->{DATE}) {
        _parse_rcs_header($self);
    }
    my $revision = shift || $self->head;

    # dereference date hash
    my %date_array = %{ $self->{DATE} };
    my $date_str = $date_array{$revision};

    return wantarray ? localtime($date_str) : $date_str;
}

#------------------------------------------------------------------
# revisions
#------------------------------------------------------------------
sub revisions {
    my $self = shift;

    if (not @@{ $self->{REVISIONS} }) {
        _parse_rcs_header($self);
    }

    # dereference revisions list
    my @@revisions = @@{ $self->{REVISIONS} };

    @@revisions;
}

#------------------------------------------------------------------
# rlog
# Execute RCS 'rlog' program.
# Make archive filename same as working filename unless
# specifically set.
#------------------------------------------------------------------
sub rlog {
    my $self = shift;
    my @@param = @@_;

    my $rlogprog = $self->bindir . $Dir_Sep . 'rlog' . $Exe_Ext;
    my $rcsdir = $self->rcsdir;
    my $arcfile = $self->arcfile || $self->file;

    # un-taint parameter string
    my $param_str = join(' ', @@param);
    $param_str =~ s/([\w-]+)/$1/g;

    my $archive_file = $rcsdir . $Dir_Sep . $arcfile . $self->arcext;
    croak "rlog program $rlogprog not found" unless -e $rlogprog;
    croak "rlog program $rlogprog not executable" unless -x $rlogprog;
    open(RLOG, "$rlogprog $param_str $archive_file |");

    my @@logoutput = <RLOG>;
    close RLOG;
    croak "$rlogprog failed" if $?;
    @@logoutput;
}

#------------------------------------------------------------------
# state
# If revision is not provided, default to 'head' revision
#------------------------------------------------------------------
sub state {
    my $self = shift;

    if (not defined $self->{STATE}) {
        _parse_rcs_header($self);
    }
    my $revision = shift || $self->head;

    # dereference author hash
    my %state_array = %{ $self->{STATE} };

    return $state_array{$revision};
}

#------------------------------------------------------------------
# symbol
# If revision is not provided, default to 'head' revision
#------------------------------------------------------------------
sub symbol {
    my $self = shift;

    if (not defined $self->{SYMBOLS}) {
        _parse_rcs_header($self);
    }
    my $revision = shift || $self->head;

    # dereference symbols hash
    my %sym_array = %{ $self->{SYMBOLS} };

    return '' if not defined $sym_array{$revision};

    my @@symbols = @@{ $sym_array{$revision} };

    # return only first array element if user wants scalar
    return wantarray ? @@symbols : $symbols[0];
}

#------------------------------------------------------------------
# symbols
# Returns hash of all revisions keyed on symbol defined against file.
#------------------------------------------------------------------
sub symbols {
    my $self = shift;

    if(not defined $self->{SYMBOLS}) {
        _parse_rcs_header($self);
    }

    my %symbols;

    # loop through each revision
    my $rev;
    foreach $rev (@@{ $self->{REVISIONS} }) {
        my $sym;
        foreach $sym (@@{ $self->{SYMBOLS}->{$rev} }) {
            $symbols{$sym} = $rev;
        }
    }
    return %symbols;
}

#------------------------------------------------------------------
# symrev
# Returns the revision against which a specified symbol was
# defined. If the symbol was not defined against any version
# of this file, 0 is returned.
#------------------------------------------------------------------
sub symrev {
    my $self = shift;
    my $sym = shift;
    if(! defined $sym) {
        croak "You must supply a symbol to symrev";
    }

    if (not defined $self->{SYMBOLS}) {
        _parse_rcs_header($self);
    }

    my $ret_rev = 0;
    my %symbols;

    # loop through each revision
    my $rev;
    REV_LOOP:
    foreach $rev (@@{ $self->{REVISIONS} }) {
        # loop through each symbol defined against
        # this revision
        my $s;
        foreach $s (@@{ $self->{SYMBOLS}->{$rev} }) {

            # store each revision matching the pattern
            if (wantarray) {
                $symbols{$s} = $rev if $s =~ /$sym/;
            }

            # if it's the one we're looking for, we can
            # quit as we've found the revision we want
            else {
                if($s eq $sym) {
                    $ret_rev = $rev;
                    last REV_LOOP;
                }
            }
        }
    }

    return wantarray ? %symbols : $ret_rev;
}

#------------------------------------------------------------------
# workdir
# Location of working directory.
#------------------------------------------------------------------
sub workdir {
    my $self = shift;

    # called as object method
    if (ref $self) {
        if (@@_) { $self->{"_WORKDIR"} = shift }
        return ref $self->{"_WORKDIR"} ? ${ $self->{"_WORKDIR"} } : $self->{"_WORKDIR"};
    }

    # called as class method
    else {
        if (@@_) { $Work_Dir = shift }
        return $Work_Dir;
    }
}

#------------------------------------------------------------------
# _parse_rcs_body
# Private function
#------------------------------------------------------------------
sub _parse_rcs_body {

    my $self = shift;
    local $_;

    my %comments;

    my $rcsdir = $self->rcsdir;
    my $file = $self->file;
    my $rcs_file = $rcsdir . $Dir_Sep . $file . $self->arcext;

    # parse RCS archive file
    open RCS_FILE, $rcs_file
        or croak "Unable to open $rcs_file";

    # skip header info and get description
    DESC: while (<RCS_FILE>) {
        if (/^desc$/) {
            while (1) {
                $_ = <RCS_FILE>;
                (chomp $comments{0} and last DESC)
                    if /^\@@$/;
                s/^\@@//;
                $comments{0} .= $_;
            }
        }
    }

    # parse body
    my $revision;
    REVISION: while (<RCS_FILE>) {
        if (/^[\d\.]+$/) {
            chomp(my $revision = $_);
            my $next = <RCS_FILE>;
            if ($next =~ /^log$/) {
                while (1) {
                    $_ = <RCS_FILE>;
                    (chomp $comments{$revision} and next REVISION)
                        if /^\@@$/;
                    s/^\@@//;
                    $comments{$revision} .= $_;
                }
            }
        }
    }
    close RCS_FILE;

    $self->{COMMENTS} = \%comments;

}

#------------------------------------------------------------------
# _parse_rcs_header
# Private function
# Directly parse the RCS archive file.
#------------------------------------------------------------------
sub _parse_rcs_header {

    my $self = shift;
    local $_;

    my ($head, $lock);
    my (@@access_list, @@revisions);
    my (%author, %date, %state, %symbols);

    my $rcsdir = $self->rcsdir;
    my $file = $self->file;
    my $rcs_file = $rcsdir . $Dir_Sep . $file . $self->arcext;

    # parse RCS archive file
    open RCS_FILE, $rcs_file
        or croak "Unable to open $rcs_file";
    while (<RCS_FILE>) {
        next if /^\s*$/;    # skip blank lines
        last if /^desc$/;   # end of header info

        # get head revision
        if (/^head\s/) {
            ($head) = /^head\s+(.*?);$/;
            next;
        }

        # get access list
        if (/^access$/) {
            while (<RCS_FILE>) {
                chomp;
                s/\s//g;        # remove all whitespace
                push @@access_list, (split(/;/))[0];
                last if /;$/;
            }
            next;
        }

        # get locker
        # get symbols
        if (/^symbols$/) {
            while (<RCS_FILE>) {
                chomp;
                s/\s//g;        # remove all whitespace
                my ($sym, $rev) = split(/:/);
                $rev =~ s/;$//;
                push @@{ $symbols{$rev} }, $sym;
                last if /;$/;
            }
            next;
        }

        # get locker
        if (/^locks/) {

            # file not locked
            if (/strict/) {
                $lock = '';
                next;
            }

            # get user who has file locked
            my $next_line = <RCS_FILE>;    # read next line
            ($lock) = $next_line =~ m/^\s*(\w+):/;
            next;
        }

        # get all revisions
        if (/^\d+\.\d+/) {
            chomp;
            push @@revisions, $_;

            # get author, state and date of each revision
            my $next_line = <RCS_FILE>;
            chop(my $author = (split(/\s+/, $next_line))[3]);
            chop(my $state  = (split(/\s+/, $next_line))[5]);
            chop(my $date   = (split(/\s+/, $next_line))[1]);

            # store date as date number
            my ($year, $mon, $mday, $hour, $min, $sec) = split(/\./, $date);
            $mon--;        # convert to 0-11 range
            my @@date = ($sec,$min,$hour,$mday,$mon,$year);

            # store value in hash using revision as key
            $author{$_} = $author;
            $state{$_} =  $state;
            $date{$_} =   timegm(@@date);
        }
    }
    close RCS_FILE;

    $self->{HEAD}        = $head;
    $self->{LOCK}        = $lock;
    $self->{ACCESS}      = \@@access_list;
    $self->{REVISIONS}   = \@@revisions;
    $self->{AUTHOR}      = \%author;
    $self->{DATE}        = \%date;
    $self->{STATE}       = \%state;
    $self->{SYMBOLS}     = \%symbols;
}

1;

__END__

=head1 NAME

Rcs - Perl Object Class for Revision Control System (RCS).

=head1 SYNOPSIS

    use Rcs;

=head1 DESCRIPTION

This Perl module provides an object oriented interface to access 
B<Revision Control System (RCS)> utilities.  RCS must be installed on
the system prior to using this module.  This module should simplify
the creation of an RCS front-end.

=head2 OBJECT CONSTRUCTOR

The B<new> method may be used as either a class method or an object
method to create a new object.

    # called as class method
    $obj = Rcs->new;

    # called as object method
    $newobj = $obj->new;

=head2 CLASS METHODS

Besides the object constructor, there are three class methods provided
which effect any newly created objects.

The B<arcext> method sets the RCS archive extension, which is ',v' by
default.

    # set/unset RCS archive extension
    Rcs->arcext('');            # set no archive extension
    Rcs->arcext(',v');          # set archive extension to ',v'
    $arc_ext = Rcs->arcext();   # get current archive extension

The B<bindir> method sets the directory path where the RCS executables
(i.e. rcs, ci, co) are located.  The default location is '/usr/local/bin'.

    # set RCS bin directory
    Rcs->bindir('/usr/bin');

    # access RCS bin directory
    $bin_dir = Rcs->bindir;

The B<quiet> method sets/unsets the quiet mode for the RCS executables.
Quiet mode is set by default.

    # set/unset RCS quiet mode
    Rcs->quiet(0);      # unset quiet mode
    Rcs->quiet(1);      # set quiet mode

    # access RCS quiet mode
    $quiet_mode = Rcs->quiet;

These methods may also be called as object methods.

    $obj->arcext('');
    $obj->bindir('/usr/bin');
    $obj->quiet(0);

=head2 OBJECT ATTRIBUTE METHODS

These methods set the attributes of the RCS object.

The B<file> method is used to set the name of the RCS working file.  The
filename must be set before invoking any access of modifier methods on the
object.

    $obj->file('mr_anderson.pl');

The B<arcfile> method is used to set the name of the RCS archive file.
Using this method is optional, as the other methods will assume the archive
filename is the same as the working file unless specified otherwise.  The
RCS archive extension (default ',v') is automatically added to the filename.

    $obj->arcfile('principle_mcvicker.pl');

The B<workdir> methods set the path of the RCS working directory.  If not
specified, default path is '.' (current working directory).

    $obj->workdir('/usr/local/source');

The B<rcsdir> methods set the path of the RCS archive directory.  If not
specified, default path is './RCS'.

    $obj->rcsdir('/usr/local/archive');

=head2 RCS PARSE METHODS

This class provides methods to directly parse the RCS archive file.

The B<access> method returns a list of all user on the access list.

    @@access_list = $obj->access;

The B<author> method returns the author of the revision.  The head revision
is used if no revision argument is passed to method.

    # returns the author of revision '1.3'
    $author = $obj->author('1.3');

    # returns the authos of the head revision
    $author = $obj->author;

The B<head> method returns the head revision.

    $head = $obj->head;

The B<lock> method returns the locker of the revision.  The method returns
null if the revision is unlocked.  The head revision is used if no revision
argument is passed to method.

    # returns locker of revision '1.3'
    $locker = $obj->lock('1.3');

    # returns locker of head revision
    $locker = $obj->lock;

The B<revisions> method returns a list of all revisions of archive file.

    @@revisions = $obj->revisions;

The B<state> method returns the state of the revision. The head revision
is used if no revision argument is passed to method.

    # returns state of revision '1.3'
    $state = $obj->state('1.3');

    # returns state of head revision
    $state = $obj->state;

The B<symbol> method returns the symbol(s) associated with a revision.
If called in list context, method returns all symbols associated with
revision.  If called in scalar context, method returns last symbol
assciated with a revision.  The head revision is used if no revision argument
is passed to method.

    # list context, returns all symbols associated with revision 1.3
    @@symbols = $obj->symbol('1.3');

    # list context, returns all symbols associated with head revision
    @@symbols = $obj->symbol;

    # scalar context, returns last symbol associated with revision 1.3
    $symbol = $obj->symbol('1.3');

    # scalar context, returns last symbol associated with head revision
    $symbol = $obj->symbol;

The B<symbols> method returns a hash, keyed by symbol, of all of the revisions
associated with the file.

    %symbols = $obj->symbols;
    foreach $sym (keys %symbols) {
        $rev = $symbols{$sym};
    }

The B<revdate> method returns the date of a revision.  The returned date format
is the same as the localtime format.  When called as a scalar, it returns the 
system date number.  If called is list context, the list
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) is returned.

    # scalar mode
    $scalar_date = $obj->revdate;
    print "Scalar date number = $scalar_date\n";
    $date_str = localtime($scalar_date);
    print "Scalar date string = $date_str\n";

    # list mode
    @@list_date = $obj->revdate;
    print "List date = @@list_date\n";

The B<dates> method returns a hash of revision dates, keyed on revision.  The
hash values are system date numbers.  When called in scalar mode, the method
returns the most recent revision date.

    # list mode
    %DatesHash = obj->dates;
    @@dates_list = sort {$b<=>$a} values %DatesHash;
    $MostRecent = $dates_list[0];

    # scalar mode
    $most_recent = $obj->dates;
    print "Most recent date = $most_recent\n";
    $most_recent_str = localtime($most_recent);
    print "Most recent date string = $most_recent_str\n";

The B<symrev> method returns the revision against which a specified symbol was
defined. If the symbol was not defined against any version of this file, 0 is
returned.

    # gets revision that has 'MY_SYMBOL' defined against it
    $rev = symrev('MY_SYMBOL');

The B<daterev> method returns a revision which was current at a specified
date/time. If all revisions are newer than the specified date/time, i.e. the
file did not exist then, 0 is returned.

    # gets revision that was active on 25th June 1998 16:45:30
    $rev = daterev(1998, 6, 25, 16, 45, 30);

The B<comments> method returns a hash of revision comments, keyed on revision.
A key value of 0 returns the description.

    %comments = $obj->comments;
    $description = $comments{0};
    $comment_1_3 = $comments{'1.3'};

=head2 RCS SYSTEM METHODS

These methods invoke the RCS system utilities.

The B<ci> method calls the RCS ci program.

    # check in, and then check out in unlocked state
    $obj->ci('-u');

The B<co> method calls the RCS co program.

    # check out in locked state
    $obj->co('-l');

The B<rcs> method calls the RCS rcs program.

    # lock file
    $obj->rcs('-l');

The B<rcsdiff> method calls the RCS rcsdiff program.  When called in
list context, this method returns the outpout of the rcsdiff program.
When called in scalar context, this method returns the return status of
the rcsdiff program.  The return status is 0 for the same, 1 for some
differences, and 2 for error condition.

When called without parameters, rcsdiff does a diff between the current
working file, and the last revision checked in.

    # call in list context
    @@diff_output = $obj->rcsdiff;

    # call in scalar context
    $changed = $obj->rcsdiff;
    if ($changed) {
        print "Working file has changed\n";
    }

Call rcsdiff with parameters to do a diff between any two revisions.

    @@diff_output = $obj->rcsdiff('-r1.2', '-r1.1');

The B<rlog> method calls the RCS rlog program.  This method returns the
output of the rlog program.

    # get complete log output
    @@rlog_complete = $obj->rlog;

    # called with '-h' switch outputs only header information
    @@rlog_header = $obj->rlog('-h');
    print @@rlog_header;

The B<rcsclean> method calls the RCS rcsclean program.

    # remove working file
    $obj->rcsclean;


=head1 EXAMPLES

=head2 CREATE ACCESS LIST

Using method B<rcs> with the B<-a> switch allows you to add users to
the access list of an RCS archive file.

    use Rcs;
    $obj = Rcs->new;

    $obj->rcsdir("./project_tree/archive");
    $obj->workdir("./project_tree/src");
    $obj->file("cornholio.pl");

Methos B<rcs> invokes the RCS utility rcs with the same parameters.

    @@users = qw(beavis butthead);
    $obj->rcs("-a@@users");

Calling method B<access> returns list of users on access list.

    $filename = $obj->file;
    @@access_list = $obj->access;
    print "Users @@access_list are on the access list of $filename\n";


=head2 PARSE RCS ARCHIVE FILE

Set class variables and create 'RCS' object.
Set bin directory where RCS programs (e.g. rcs, ci, co) reside.  The
default is '/usr/local/bin'.  This sets the bin directory for all objects.

    use Rcs;
    Rcs->bindir('/usr/bin');
    $obj = Rcs->new;

Set information regarding RCS object.  This information includes name of the
working file, directory of working file ('.' by default), and RCS archive
directory ('./RCS' by default).

    $obj->rcsdir("./project_tree/archive");
    $obj->workdir("./project_tree/src");
    $obj->file("cornholio.pl");

    $head_rev = $obj->head;
    $locker = $obj->lock;
    $author = $obj->author;
    @@access = $obj->access;
    @@revisions = $obj->revisions;

    $filename = $obj->file;

    if ($locker) {
        print "Head revision $head_rev is locked by $locker\n";
    }
    else {
        print "Head revision $head_rev is unlocked\n";
    }

    if (@@access) {
        print "\nThe following users are on the access list of file $filename\n";
        map { print "User: $_\n"} @@access;
    }

    print "\nList of all revisions of $filename\n";
    foreach $rev (@@revisions) {
        print "Revision: $rev\n";
    }

=head2 CHECK-IN FILE

Set class variables and create 'RCS' object.
Set bin directory where RCS programs (e.g. rcs, ci, co) reside.  The
default is '/usr/local/bin'.  This sets the bin directory for all objects.

    use Rcs;
    Rcs->bindir('/usr/bin');
    Rcs->quiet(0);      # turn off quiet mode
    $obj = Rcs->new;

Set information regarding RCS object.  This information includes name of
working file, directory of working file ('.' by default), and RCS archive
directory ('./RCS' by default).

    $obj->file('cornholio.pl');

    # Set RCS archive directory, is './RCS' by default
    $obj->rcsdir("./project_tree/archive");

    # Set working directory, is '.' by default
    $obj->workdir("./project_tree/src");

Check in file using B<-u> switch.  This will check in the file, and will then
check out the file in an unlocked state.  The B<-m> switch is used to set the
revision comment.

Command:

    $obj->ci('-u', '-mRevision Comment');

is equivalent to commands:

    $obj->ci('-mRevision Comment');
    $obj->co;

=head2 CHECK-OUT FILE

Set class variables and create 'RCS' object.
Set bin directory where RCS programs (e.g. rcs, ci, co) reside.  The
default is '/usr/local/bin'.  This sets the bin directory for all objects.

    use Rcs;
    Rcs->bindir('/usr/bin');
    Rcs->quiet(0);      # turn off quiet mode
    $obj = Rcs->new;

Set information regarding RCS object.  This information includes name of
working file, directory of working file ('.' by default), and RCS archive
directory ('./RCS' by default).

    $obj->file('cornholio.pl');

    # Set RCS archive directory, is './RCS' by default
    $obj->rcsdir("./project_tree/archive");

    # Set working directory, is '.' by default
    $obj->workdir("./project_tree/src");

Check out file read-only:

    $obj->co;

or check out and lock file:

    $obj->co('-l');

=head2 RCSDIFF

Method B<rcsdiff> does an diff between revisions.

    $obj = Rcs->new;
    $obj->bindir('/usr/bin');

    $obj->rcsdir("./project_tree/archive");
    $obj->workdir("./project_tree/src");
    $obj->file("cornholio.pl");

    print "Diff of current working file\n";
    if ($obj->rcsdiff) {       # scalar context
        print $obj->rcsdiff;   # list context
    }
    else {
       print "Versions are Equal\n";
    }

    print "\n\nDiff of revisions 1.2 and 1.1\n";
    print $obj->rcsdiff('-r1.2', '-r1.1');

=head2 RCSCLEAN

Method B<rcsclean> will remove an unlocked working file.

    use Rcs;
    Rcs->bindir('/usr/bin');
    Rcs->quiet(0);      # turn off quiet mode
    $obj = Rcs->new;

    $obj->rcsdir("./project_tree/archive");
    $obj->workdir("./project_tree/src");
    $obj->file("cornholio.pl");

    print "Quiet mode NOT set\n" unless Rcs->quiet;

    $obj->rcsclean;

=head1 AUTHOR

Craig Freter, E<lt>F<craig@@freter.com>E<gt>

=head1 CONTRIBUTORS

David Green, E<lt>F<greendjf@@cvhp152.gpt.co.uk>E<gt>

    David Green contributed the B<dates> method.

Jamie O'Shaughnessy, E<lt>F<jamie@@thanatar.demon.co.uk>E<gt>

    Contributed NT port.
    Contributed methods B<daterev>, B<symrev>, and B<symbols>.

=head1 COPYRIGHT

Copyright (C) 1997,1998 Craig Freter.  All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

@


1.14
log
@Added comments method
@
text
@d12 1
a12 1
$revision = '$Id: Rcs.pm,v 1.13 1998/07/15 01:27:11 freter Exp freter $';
d34 1
a34 1
    $self->{"_ARCEXT"} = \$Arc_Ext;
d77 2
a78 2
        if (@@_) { ${ $self->{"_ARCEXT"} } = shift };
        return ${ $self->{"_ARCEXT"} };
d111 1
a111 1
    my $revision = shift || $self->{HEAD};
d129 2
a130 2
        if (@@_) { ${ $self->{"_BINDIR"} } = shift };
        return ${ $self->{"_BINDIR"} };
d150 5
a154 5
    my $ciprog = ${ $self->{"_BINDIR"} } . $Dir_Sep . 'ci' . $Exe_Ext;
    my $rcsdir = ${ $self->{"_RCSDIR"} };
    my $workdir = ${ $self->{"_WORKDIR"} };
    my $file = $self->{FILE};
    my $arcfile = $self->{ARCFILE} || $file;
d156 1
a156 1
    my $archive_file = $rcsdir . $Dir_Sep . $arcfile . ${ $self->{"_ARCEXT"} };
d159 1
a159 1
    unshift @@param, "-q" if ${ $self->{"_QUIET"} };     # quiet mode
d168 1
a168 1
    $self->{COMMENTS}   = undef;
d181 5
a185 5
    my $coprog = ${ $self->{"_BINDIR"} } . $Dir_Sep . 'co' . $Exe_Ext;
    my $rcsdir = ${ $self->{"_RCSDIR"} };
    my $workdir = ${ $self->{"_WORKDIR"} };
    my $file = $self->{FILE};
    my $arcfile = $self->{ARCFILE} || $file;
d187 1
a187 1
    my $archive_file = $rcsdir . $Dir_Sep . $arcfile . ${ $self->{"_ARCEXT"} };
d190 1
a190 1
    unshift @@param, "-q" if ${ $self->{"_QUIET"} };     # quiet mode
d199 1
a199 1
    $self->{COMMENTS}   = undef;
d336 2
a337 2
            ${ $self->{"_QUIET"} } = $mode;
            return ${ $self->{"_QUIET"} };
d342 1
a342 1
            return ${ $self->{"_QUIET"} };
d375 5
a379 5
    my $rcsprog = ${ $self->{"_BINDIR"} } . $Dir_Sep . 'rcs' . $Exe_Ext;
    my $rcsdir = ${ $self->{"_RCSDIR"} };
    my $workdir = ${ $self->{"_WORKDIR"} };
    my $file = $self->{FILE};
    my $arcfile = $self->{ARCFILE} || $file;
d381 1
a381 1
    my $archive_file = $rcsdir . $Dir_Sep . $arcfile . ${ $self->{"_ARCEXT"} };
d384 1
a384 1
    unshift @@param, "-q" if ${ $self->{"_QUIET"} };     # quiet mode
d393 1
a393 1
    $self->{COMMENTS}   = undef;
d404 5
a408 5
    my $rcscleanprog = ${ $self->{"_BINDIR"} } . $Dir_Sep . 'rcsclean' . $Exe_Ext;
    my $rcsdir = ${ $self->{"_RCSDIR"} };
    my $workdir = ${ $self->{"_WORKDIR"} };
    my $file = $self->{FILE};
    my $arcfile = $self->{ARCFILE} || $file;
d410 1
a410 1
    my $archive_file = $rcsdir . $Dir_Sep . $arcfile . ${ $self->{"_ARCEXT"} };
d421 1
a421 1
    $self->{COMMENTS}   = undef;
d435 4
a438 4
    my $rcsdiff_prog = ${ $self->{"_BINDIR"} } . $Dir_Sep . 'rcsdiff' . $Exe_Ext;
    my $rcsdir = ${ $self->{"_RCSDIR"} };
    my $arcfile = $self->{ARCFILE} || $self->{FILE};
    $arcfile = $rcsdir . $Dir_Sep . $arcfile . ${ $self->{"_ARCEXT"} };
d442 1
a442 1
    unshift @@param, "-q" if ${ $self->{"_QUIET"} };     # quiet mode
d468 2
a469 2
        if (@@_) { ${ $self->{"_RCSDIR"} } = shift }
        return ${ $self->{"_RCSDIR"} };
d493 1
a493 1
    my $revision = shift || $self->{HEAD};
d528 3
a530 3
    my $rlogprog = ${ $self->{"_BINDIR"} } . $Dir_Sep . 'rlog' . $Exe_Ext;
    my $rcsdir = ${ $self->{"_RCSDIR"} };
    my $arcfile = $self->{ARCFILE} || $self->{FILE};
d536 1
a536 1
    my $archive_file = $rcsdir . $Dir_Sep . $arcfile . ${ $self->{"_ARCEXT"} };
d557 1
a557 1
    my $revision = shift || $self->{HEAD};
d575 1
a575 1
    my $revision = shift || $self->{HEAD};
d669 2
a670 2
        if (@@_) { ${ $self->{"_WORKDIR"} } = shift }
        return ${ $self->{"_WORKDIR"} };
d691 3
a693 3
    my $rcsdir = ${ $self->{"_RCSDIR"} };
    my $file = $self->{FILE};
    my $rcs_file = $rcsdir . $Dir_Sep . $file . ${ $self->{"_ARCEXT"} };
d749 3
a751 3
    my $rcsdir = ${ $self->{"_RCSDIR"} };
    my $file = $self->{FILE};
    my $rcs_file = $rcsdir . $Dir_Sep . $file . ${ $self->{"_ARCEXT"} };
@


1.13
log
@Made additional changes to methods contributed by Jamie O'Shaughnessy
@
text
@d12 1
a12 1
$revision = '$Id: Rcs.pm,v 1.12 1998/07/08 06:07:51 freter Exp freter $';
d39 1
d59 1
a59 1
        _parse_rcs($self);
d109 1
a109 1
        _parse_rcs($self);
d166 3
a168 2
    # re-parse RCS file
    _parse_rcs($self);
d197 16
a212 2
    # re-parse RCS file
    _parse_rcs($self);
d238 1
a238 1
        _parse_rcs($self);
d275 1
a275 1
        _parse_rcs($self);
d303 1
a303 1
        _parse_rcs($self);
d316 1
a316 1
        _parse_rcs($self);
d391 3
a393 2
    # re-parse RCS file
    _parse_rcs($self);
d419 3
a421 2
    # re-parse RCS file
    _parse_rcs($self);
d491 1
a491 1
        _parse_rcs($self);
d509 1
a509 1
        _parse_rcs($self);
d555 1
a555 1
        _parse_rcs($self);
d573 1
a573 1
        _parse_rcs($self);
d596 1
a596 1
        _parse_rcs($self);
d626 1
a626 1
        _parse_rcs($self);
d681 56
a736 1
# _parse_rcs
d740 1
a740 1
sub _parse_rcs {
d846 1
a846 1
Rcs - Perl Class for Revision Control System (RCS).
d872 1
a872 1
Besides the object constructor, there are two class methods provided
d875 8
a901 8
The B<arcext> method sets the RCS archive extension, which is ',v' by
default.

    # set/unset RCS archive extension
    Rcs->arcext('');            # set no archive extension
    Rcs->arcext(',v');          # set archive extension to ',v'
    $arc_ext = Rcs->arcext();   # get current archive extension

d904 1
a906 1
    $obj->arcext('');
d997 2
a998 2
The B<symbols> method returns a list of all of the symbols associated with
the file.
d1000 4
a1003 1
    @@symbols = $obj->symbols;
d1048 7
@


1.12
log
@Merge and modify methods contributed by Jamie O'Shaughnessy
@
text
@d12 1
a12 1
$revision = '$Id: Rcs.pm,v 1.11 1998/07/05 18:29:06 freter Exp freter $';
d72 13
a84 13
	my $self = shift;
	
	# called as object method
	if (ref $self) {
		if (@@_) { ${ $self->{"_ARCEXT"} } = shift };
		return ${ $self->{"_ARCEXT"} };
	}
	
	# called as class method
	else {
		if (@@_) { $Arc_Ext = shift; }
		return $Arc_Ext;
	}
d200 47
d294 1
a484 95
# symrev
# Returns the revision against which a specified symbol was
# defined. If the symbol was not defined against any version
# of this file, 0 is returned.
#------------------------------------------------------------------
sub symrev {
    my $self = shift;
    my $sym = shift;
    if(! defined $sym) {
        croak "You must supply a symbol to symrev";
    }

    if (not defined $self->{SYMBOLS}) {
        _parse_rcs($self);
    }

    my $ret_rev = 0;
    my %symbols;

    # loop through each revision
    my $rev;
    REV_LOOP:
    foreach $rev (@@{ $self->{REVISIONS} }) {
        # loop through each symbol defined against
        # this revision
        my $s;
        foreach $s (@@{ $self->{SYMBOLS}->{$rev} }) {

            # store each revision matching the pattern
            if (wantarray) {
                $symbols{$s} = $rev if $s =~ /$sym/;
            }

            # if it's the one we're looking for, we can
            # quit as we've found the revision we want
            else {
                if($s eq $sym) {
                    $ret_rev = $rev;
                    last REV_LOOP;
                }
            }
        }
    }

    return wantarray ? %symbols : $ret_rev;
}

#------------------------------------------------------------------
# daterev
# Returns a revision which was current at a specified date/time.
# 0 is returned if all revisions are newer than the date 
# specified. This usually means the file did not exist on that
# date.
# This takes 6 parameters, year (4 digit year), month (1-12), day
# of month (1-31), hour (0-23), minute (0-59) and second (0-59).
#------------------------------------------------------------------
sub daterev {
    my $self = shift;
    my($year, $mon, $mday, $hour, $min, $sec) = @@_;

    # ensure date has all the elements
    if(@@_ != 6) {
        croak "daterev must have 6 element date/time (year, month, day, hour, min, sec)";
    }

    if($year !~ /^\d{4}$/) {
        croak "year (1st param) must be 4 digit number";
    }

    if (not defined $self->{DATE}) {
        _parse_rcs($self);
    }

    $mon--;        # convert to 0-11 range
    my $target_time = timegm($sec, $min, $hour, $mday, $mon, $year);
    my @@revisions;
    my %dates;

    my %dates_hash = %{$self->{DATE}};
    foreach $revision (keys %dates_hash) {
        my $date = $dates_hash{$revision};
        $dates{$date}{$revision} = 1;
    }

    my $date;
    foreach $date (reverse sort keys %dates) {
        foreach $revision (keys %{ $dates{$date} }) {
            push @@revisions, $revision if $date <= $target_time;
        }
    }

    return wantarray ? @@revisions : $revisions[0];
}

#------------------------------------------------------------------
d572 1
a572 1
# Returns list of all symbols defined against file
d575 65
a639 16
	my $self = shift;
	
	if(not defined $self->{SYMBOLS}) {
		_parse_rcs($self);
	}
	
	my @@retval;
	
	# loop through each revision
	my $rev;
	foreach $rev (@@{ $self->{REVISIONS} }) {
		# adding the symbols defined against that revision to
		# our list of all the symbols defined against this file
		push @@retval, @@{ $self->{SYMBOLS}->{$rev} };
	}
	return @@retval;;
d678 2
a679 2
	my $rcs_file = $rcsdir . $Dir_Sep . $file . ${ $self->{"_ARCEXT"} };
	
a943 1
<<<<<<< Rcs.pm
d971 1
a971 1
	$rev = daterev(1998, 6, 25, 16, 45, 30);
d1209 1
a1209 1
=head1 CONTRIBUTOR
d1213 6
a1218 1
David Green contributed the B<dates> method.
@


1.11
log
@Add dates method contributed by David Green
@
text
@d11 4
a14 2
$VERSION = '0.06';
$revision = '$Id: Rcs.pm,v 1.10 1998/05/09 21:45:49 freter Exp $';
d16 1
a16 1
my $Rcs_Dir = './RCS';
d19 1
d34 1
d68 20
d90 2
a91 2
# If not set then return name of working file with ',v' RCS
# extension.
d96 1
a96 1
    return $self->{ARCFILE} || $self->{FILE} . ',v';
d149 1
a149 1
    my $ciprog = ${ $self->{"_BINDIR"} } . '/' . 'ci';
d155 2
a156 2
    my $archive_file = $rcsdir . '/' . $arcfile . ',v';
    my $workfile = $workdir . '/' . $file;
d179 1
a179 1
    my $coprog = ${ $self->{"_BINDIR"} } . '/' . 'co';
d185 2
a186 2
    my $archive_file = $rcsdir . '/' . $arcfile . ',v';
    my $workfile = $workdir . '/' . $file;
d311 1
a311 1
    my $rcsprog = ${ $self->{"_BINDIR"} } . '/' . 'rcs';
d317 2
a318 2
    my $archive_file = $rcsdir . '/' . $arcfile . ',v';
    my $workfile = $workdir . '/' . $file;
d339 1
a339 1
    my $rcscleanprog = ${ $self->{"_BINDIR"} } . '/' . 'rcsclean';
d345 2
a346 2
    my $archive_file = $rcsdir . '/' . $arcfile . ',v';
    my $workfile = $workdir . '/' . $file;
d369 1
a369 1
    my $rcsdiff_prog = ${ $self->{"_BINDIR"} } . '/' . 'rcsdiff';
d372 2
a373 2
    $arcfile = $rcsdir . '/' . $arcfile . ',v';
    my $workfile = $self->workdir . '/' . $self->file;
d437 95
d557 1
a557 1
    my $rlogprog = ${ $self->{"_BINDIR"} } . '/' . 'rlog';
d565 1
a565 1
    my $archive_file = $rcsdir . '/' . $arcfile . ',v';
d618 23
d676 2
a677 1

d679 2
a680 2
    open RCS_FILE, "$rcsdir/$file,v"
        or croak "Unable to open $rcsdir/$file,v";
d810 1
a810 1
Quiet mode is set bt default.
d819 8
d831 1
d846 1
a846 1
',v' RCS archive extension is automatically added to the filename.
d904 1
a904 1
The B<symbol> method returns the sysbol(s) associated with a revision.
d922 5
d942 1
d958 14
d1221 1
@


1.10
log
@Fix revdate documentation
@
text
@d11 2
a12 2
$VERSION = '0.05';
$revision = '$Id: Rcs.pm,v 1.9 1998/05/08 03:39:11 freter Exp freter $';
d176 23
d409 1
a409 5
    my ($year, $mon, $mday, $hour, $min, $sec) = split(/\./, $date_str);
    $mon--;        # convert to 0-11 range
    my @@date = ($sec,$min,$hour,$mday,$mon,$year);

    return wantarray ? localtime(timegm(@@date)) : timegm(@@date);
d593 1
a593 1
            # get author, date and state of each revision
a594 1
            chop(my $date   = (split(/\s+/, $next_line))[1]);
d597 8
a604 1
            $date{$_} =   $date;
d607 1
d755 1
a755 1
assciated with revision.  The head revision is used if no revision argument
d785 15
d1036 6
d1044 1
a1044 1
Copyright (C) 1997, Craig Freter.  All rights reserved.
@


1.10.1.1
log
@NT port.  Contributed by Jamie O'Shaughnessy
@
text
@a6 1
use Date::Calc qw(Delta_DHMS);
d11 2
a12 4
$VERSION = '0.052';
$revision = '$Id: Rcs.pm,v 1.10 1998/05/09 21:45:49 freter Exp $';
my $Dir_Sep = ($^O eq 'MSWin32') ? '\\' : '/';
my $Exe_Ext = ($^O eq 'MSWin32') ? '.exe' : '';
d14 1
a14 1
my $Rcs_Dir = '.' . $Dir_Sep . 'RCS';
a16 1
my $Arc_Ext = ',v';
a30 1
    $self->{"_ARCEXT"} = \$Arc_Ext;
a63 20
# arcext
# Set the RCS archive file extension (default is ',v').
#------------------------------------------------------------------
sub arcext {
	my $self = shift;
	
	# called as object method
	if (ref $self) {
		if (@@_) { ${ $self->{"_ARCEXT"} } = shift };
		return ${ $self->{"_ARCEXT"} };
	}
	
	# called as class method
	else {
		if (@@_) { $Arc_Ext = shift; }
		return $Arc_Ext;
	}
}

#------------------------------------------------------------------
d66 2
a67 2
# If not set then return name of working file with RCS
# extension (',v').
d72 1
a72 1
    return $self->{ARCFILE} || $self->{FILE} . ${ $self->{"_ARCEXT"} };
d125 1
a125 1
    my $ciprog = ${ $self->{"_BINDIR"} } . $Dir_Sep . 'ci' . $Exe_Ext;
d131 2
a132 2
    my $archive_file = $rcsdir . $Dir_Sep . $arcfile . ${ $self->{"_ARCEXT"} };
    my $workfile = $workdir . $Dir_Sep . $file;
d155 1
a155 1
    my $coprog = ${ $self->{"_BINDIR"} } . $Dir_Sep . 'co' . $Exe_Ext;
d161 2
a162 2
    my $archive_file = $rcsdir . $Dir_Sep . $arcfile . ${ $self->{"_ARCEXT"} };
    my $workfile = $workdir . $Dir_Sep . $file;
d264 1
a264 1
    my $rcsprog = ${ $self->{"_BINDIR"} } . $Dir_Sep . 'rcs' . $Exe_Ext;
d270 2
a271 2
    my $archive_file = $rcsdir . $Dir_Sep . $arcfile . ${ $self->{"_ARCEXT"} };
    my $workfile = $workdir . $Dir_Sep . $file;
d292 1
a292 1
    my $rcscleanprog = ${ $self->{"_BINDIR"} } . $Dir_Sep . 'rcsclean' . $Exe_Ext;
d298 2
a299 2
    my $archive_file = $rcsdir . $Dir_Sep . $arcfile . ${ $self->{"_ARCEXT"} };
    my $workfile = $workdir . $Dir_Sep . $file;
d322 1
a322 1
    my $rcsdiff_prog = ${ $self->{"_BINDIR"} } . $Dir_Sep . 'rcsdiff' . $Exe_Ext;
d325 2
a326 2
    $arcfile = $rcsdir . $Dir_Sep . $arcfile . ${ $self->{"_ARCEXT"} };
    my $workfile = $self->workdir . $Dir_Sep . $self->file;
a393 112
# symrev
# Returns the revision against which a specified symbol was
# defined. If the symbol was not defined against any version
# of this file, 0 is returned.
#------------------------------------------------------------------
sub symrev {
	my $self = shift;
	my $sym = shift;
	if(! defined $sym) {
		croak "You must supply a symbol to symrev";
	}

    if (not defined $self->{SYMBOLS}) {
        _parse_rcs($self);
    }

	my $ret_rev = 0;
	
	# loop through each revision
	my $rev;
  REV_LOOP:
	foreach $rev (@@{ $self->{REVISIONS} }) {
		# loop through each symbol defined against
		# this revision
		my $s;
		foreach $s (@@{ $self->{SYMBOLS}->{$rev} }) {
			# if it's the one we're looking for, we can
			# quit as we've found the revision we want
			if($s eq $sym) {
				$ret_rev = $rev;
				last REV_LOOP;
			}
		}
	}
	
	return $ret_rev;
}

#------------------------------------------------------------------
# daterev
# Returns a revision which was current at a specified date/time.
# 0 is returned if all revisions are newer than the date 
# specified. This usually means the file did not exist on that
# date.
# This takes 6 parameters, year (4 digit year), month (1-12), day
# of month (1-31), hour (0-23), minute (0-59) and second (0-59).
#------------------------------------------------------------------
sub daterev {
	my $self = shift;
	my(@@ymdhms) = @@_;
	# ensure date has all the elements
	if($#ymdhms != 5) {
		croak "daterev must have 6 element date/time (year, month, day, hour, min, sec)";
	}
	if($ymdhms[0] =~ /^\d{4}$/) {
		croak "year (1st param) must be 4 digit number";
	}
	
    if (not defined $self->{DATE}) {
        _parse_rcs($self);
    }
	
	my $ret_rev = 0;
	my $best_interval = 1;

	# look through each revision
	my $cur_rev;
	foreach $cur_rev (@@{ $self->{REVISIONS} }) {
		# get the date/time for this revision
		my $date_str = $self->{DATE}->{$cur_rev};
		my ($year, $mon, $mday, $hour, $min, $sec) = split(/\./, $date_str);
		# use Date::Calc to work out time between the revision's
		# and the one specified by the user
		my ($dd, $dh, $dm, $ds) = Delta_DHMS(@@ymdhms, $year, $mon, $mday, 
											 $hour, $min, $sec);
		
		# only interested in 0 or negative intervals, a +ve interval
		# indicates the check in was after our desired date and so is too
		# recent to be deemed a good match
		if(($dd <= 0) && ($dh <= 0) && ($dm <= 0) && ($ds <= 0)) {
			# work out interval in seconds
			my $interval = $ds;
			$interval += $dm * 60;    # 60 sec per min
			$interval += $dh * 3600;  # 60*60 sec per hour
			$interval += $dd * 86400; # 60*60*24 sec per day
			
			# if we've not had a possible interval before, this may
			# be the best we'll get
			if($ret_rev == 0) {
				$ret_rev = $cur_rev;
				$best_interval = $interval;
			}
			# if've we've already got a possible revision, is this
			# interval better?
			elsif($interval > $best_interval) {
				$ret_rev = $cur_rev;
				$best_interval = $interval;
			}

			# if the date/times match exact, we may as well finish as
			# it's impossible to have >1 revision with the same check
			# in time to the second, I think :)
			if($interval == 0) {
				last;
			}
		}
	}

	return $ret_rev;
}

#------------------------------------------------------------------
d419 1
a419 1
    my $rlogprog = ${ $self->{"_BINDIR"} } . $Dir_Sep . 'rlog' . $Exe_Ext;
d427 1
a427 1
    my $archive_file = $rcsdir . $Dir_Sep . $arcfile . ${ $self->{"_ARCEXT"} };
a479 23
# symbols
# Returns list of all symbols defined against file
#------------------------------------------------------------------
sub symbols {
	my $self = shift;
	
	if(not defined $self->{SYMBOLS}) {
		_parse_rcs($self);
	}
	
	my @@retval;
	
	# loop through each revision
	my $rev;
	foreach $rev (@@{ $self->{REVISIONS} }) {
		# adding the symbols defined against that revision to
		# our list of all the symbols defined against this file
		push @@retval, @@{ $self->{SYMBOLS}->{$rev} };
	}
	return @@retval;;
}

#------------------------------------------------------------------
d515 1
a515 2
	my $rcs_file = $rcsdir . $Dir_Sep . $file . ${ $self->{"_ARCEXT"} };
	
d517 2
a518 2
    open RCS_FILE, $rcs_file
        or croak "Unable to open $rcs_file";
d641 1
a641 1
Quiet mode is set by default.
a649 8
The B<arcext> method sets the RCS archive extension, which is ',v' by
default.

    # set/unset RCS archive extension
    Rcs->arcext('');            # set no archive extension
    Rcs->arcext(',v');          # set archive extension to ',v'
    $arc_ext = Rcs->arcext();   # get current archive extension

a653 1
    $obj->arcext('');
d668 1
a668 1
RCS archive extension (default ',v') is automatically added to the filename.
d726 1
a726 1
The B<symbol> method returns the symbol(s) associated with a revision.
a743 5
The B<symbols> method returns a list of all of the symbols associated with
the file.

    @@symbols = $obj->symbols;

a758 14
The B<symrev> method returns the revision against which a specified symbol was
defined. If the symbol was not defined against any version of this file, 0 is
returned.

    # gets revision that has 'MY_SYMBOL' defined against it
    $rev = symrev('MY_SYMBOL');

The B<daterev> method returns a revision which was current at a specified
date/time. If all revisions are newer than the specified date/time, i.e. the
file did not exist then, 0 is returned.

    # gets revision that was active on 25th June 1998 16:45:30
	$rev = daterev(1998, 6, 25, 16, 45, 30);

a1001 1

@


1.9
log
@Complete documentation for revdate method
@
text
@d12 1
a12 1
$revision = '$Id: Rcs.pm,v 1.8 1998/03/07 19:51:02 freter Exp freter $';
d746 12
a757 2
system date string "Thu May  7 23:16:35 EDT 1998".  If called is list context,
the list ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) is returned.
@


1.8
log
@Make rcsdir and workdir object AND class methods
Added revdate method
Bug Fix: initialize REVINFO, STATE, and SYMBOLS to undef
@
text
@d5 1
d11 2
a12 2
$VERSION = '0.03';
$revision = '$Id: Rcs.pm,v 1.7 1998/02/23 14:02:44 freter Exp $';
d370 3
d386 3
a388 2
    # return date string "as is"
    return $date_str unless wantarray;
d390 1
a390 9
    # convert date format to look like Perl localtime function
    # NOT setting 'weekday', 'yearday', and 'isDST' values returned by localtime
    my ($sec, $min, $hour, $mday, $mon, $year) = reverse split(/\./, $date_str);

    $year -= 1900 if $year > 1999;               # convert year to year + 1900
    $mon--;                                      # convert to 0-11 range
    $mon = $mon < 10 ? $mon = '0' . $mon : $mon; # pad leading zero

    return ($sec, $min, $hour, $mday, $mon, $year);
d726 1
a726 1
The B<sysbol> method returns the sysbol(s) associated with a revision.
d743 5
@


1.7
log
@Change namespace back to Rcs
@
text
@d11 1
a11 1
$revision = '$Id: Rcs.pm,v 1.6 1998/01/29 20:28:27 freter Exp freter $';
d13 2
a25 2
    $self->{RCSDIR}     = './RCS';
    $self->{WORKDIR}    = '.';
d28 2
d34 1
d38 3
a40 3
    $self->{REVINFO}    = {};
    $self->{STATE}      = {};
    $self->{SYMBOLS}    = {};
d103 2
a104 11

        # set bin dir
        if (@@_) {
            ${ $self->{"_BINDIR"} } = shift;
            return ${ $self->{"_BINDIR"} };
        }

        # access bin dir
        else {
            return ${ $self->{"_BINDIR"} };
        }
d109 2
a110 11

        # set bin dir
        if (@@_) {
            $Rcs_Bin_Dir = shift;
            return $Rcs_Bin_Dir;
        }

        # access bin dir
        else {
            return $Rcs_Bin_Dir;
        }
d125 2
a126 2
    my $rcsdir = $self->{RCSDIR};
    my $workdir = $self->{WORKDIR};
d155 2
a156 2
    my $rcsdir = $self->{RCSDIR};
    my $workdir = $self->{WORKDIR};
d264 2
a265 2
    my $rcsdir = $self->{RCSDIR};
    my $workdir = $self->{WORKDIR};
d292 2
a293 2
    my $rcsdir = $self->{RCSDIR};
    my $workdir = $self->{WORKDIR};
d322 1
a322 1
    my $rcsdir = $self->{RCSDIR};
d351 43
a393 2
    if (@@_) { $self->{RCSDIR} = shift }
    return $self->{RCSDIR};
d423 1
a423 1
    my $rcsdir = $self->{RCSDIR};
d488 12
a499 2
    if (@@_) { $self->{WORKDIR} = shift }
    return $self->{WORKDIR};
d514 1
a514 1
    my (%author, %state, %symbols);
d516 1
a516 1
    my $rcsdir = $self->{RCSDIR};
d577 1
a577 1
            # get author and state of each revision
d579 1
d582 1
d584 1
a584 1
            $state{$_} = $state;
d594 1
@


1.7.1.1
log
@Bug Fix: initialize REVINFO, STATE, and SYMBOLS to undef
@
text
@d10 2
a11 2
$VERSION = '0.04';
$revision = '$Id: Rcs.pm,v 1.7 1998/02/23 14:02:44 freter Exp freter $';
d35 3
a37 3
    $self->{REVINFO}    = undef;
    $self->{STATE}      = undef;
    $self->{SYMBOLS}    = undef;
@


1.6
log
@Increment VERSION to 0.02
@
text
@d1 1
a1 1
package Version::Rcs;
d10 2
a11 2
$VERSION = '0.02';
$revision = '$Id: Rcs.pm,v 1.5 1998/01/10 03:09:43 freter Exp freter $';
d570 1
a570 1
    use Version::Rcs;
d769 1
a769 1
Using method B<rcs> with the -a switch allows you to add users to
d772 1
a772 1
    use Version::Rcs;
d797 1
a797 1
    use Version::Rcs;
d840 1
a840 1
    use Version::Rcs;
d857 2
a858 2
Check in file using -u switch.  This will check in the file, and will then
check out the file in an unlocked state.  The -m switch is used to set the
d876 1
a876 1
    use Version::Rcs;
d927 1
a927 1
    use Version::Rcs;
@


1.5
log
@Change namespace to Version:Rcs
@
text
@d10 2
a11 2
$VERSION = '0.01';
$revision = '$Id: Rcs.pm,v 1.4 1997/12/21 12:44:52 freter Exp freter $';
@


1.4
log
@Set VERSION to 0.01
@
text
@d1 1
a1 1
package Rcs;
d11 1
a11 1
$revision = '$Id: Rcs.pm,v 1.3 1997/12/21 12:36:51 freter Exp freter $';
d570 1
a570 1
    use Rcs;
d772 1
a772 1
    use Rcs;
d797 1
a797 1
    use Rcs;
d840 1
a840 1
    use Rcs;
d876 1
a876 1
    use Rcs;
d927 1
a927 1
    use Rcs;
@


1.3
log
@Add documentation
@
text
@d10 2
a11 2
$VERSION = '0.05';
$revision = '$Id: Rcs.pm,v 1.2 1997/12/21 12:33:56 freter Exp freter $';
@


1.2
log
@POD changes
@
text
@d11 1
a11 1
$revision = '$Id: Rcs.pm,v 1.1 1997/12/21 12:29:49 freter Exp freter $';
d328 3
@


1.1
log
@Initial revision
@
text
@d11 1
a11 1
$revision = '$Id: Rcs.pm,v 1.1 1997/12/21 12:28:21 freter Exp $';
d798 1
a798 1
Set information regarding RCS object.  This information includes name of
@
