Rcs-1.05/0040755000076400007640000000000007766474535011571 5ustar freterfreterRcs-1.05/examples/0040775000076400007640000000000007766207340013375 5ustar freterfreterRcs-1.05/examples/project/0040775000076400007640000000000007765305726015051 5ustar freterfreterRcs-1.05/examples/project/RCS/0040775000076400007640000000000007765305726015500 5ustar freterfreterRcs-1.05/examples/project/RCS/testfile,v0100444000076400007640000000255106574605565017501 0ustar freterfreterhead 1.9; access; symbols; locks freter:1.9; strict; comment @# @; 1.9 date 98.09.06.22.23.47; author freter; state Exp; branches; next 1.8; 1.8 date 98.09.06.22.22.46; author freter; state Exp; branches; next 1.7; 1.7 date 98.09.06.04.24.48; author freter; state Exp; branches; next 1.6; 1.6 date 98.09.06.04.22.48; author freter; state Exp; branches; next 1.5; 1.5 date 98.09.06.02.32.55; author freter; state Exp; branches; next 1.4; 1.4 date 98.08.31.13.33.34; author freter; state Exp; branches; next 1.3; 1.3 date 98.08.31.13.08.42; author freter; state Exp; branches; next 1.2; 1.2 date 98.08.28.19.41.43; author freter; state Exp; branches; next 1.1; 1.1 date 98.08.28.19.40.20; author freter; state Exp; branches; next ; desc @@@one @@@@two @@@@@@three@@@@@@ @@ @@ @@@@ @@@@@@ @ 1.9 log @*** empty log message *** @ text @3.14 hear again @ 1.8 log @MT @ text @d1 2 @ 1.7 log @*** empty log message *** @ text @a0 11 testing line two bug fix new line line five line six line 7 3.14 log @@ooops!!! @@ @ 1.6 log @*** empty log message *** @ text @d9 1 @ 1.5 log @'@@' "@@@@" `@@@@@@` test tist! @ text @d8 3 @ 1.4 log @@@test multi-line comment@@@@@@@@@@@@ @@ @@@@ @@@@@@ @@@@@@@@ multiline comment @@ @ text @d7 1 @ 1.3 log @*** empty log message *** @ text @d6 1 @ 1.2 log @comment for 1.2 @ text @d5 1 @ 1.1 log @Initial revision @ text @d4 1 @ Rcs-1.05/examples/project/RCS/Rcs.pm,v0100444000076400007640000017367306574407661017037 0ustar freterfreterhead 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 = ; # 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 = ; 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 () { if (/^desc$/) { while (1) { $_ = ; (chomp $comments{0} and last DESC) if /^\@@$/; s/^\@@//; $comments{0} .= $_; } } } # parse body my $revision; REVISION: while () { if (/^[\d\.]+$/) { chomp(my $revision = $_); my $next = ; if ($next =~ /^log$/) { while (1) { $_ = ; (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 () { 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 () { chomp; s/\s//g; # remove all whitespace push @@access_list, (split(/;/))[0]; last if /;$/; } next; } # get locker # get symbols if (/^symbols$/) { while () { 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 = ; # 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 = ; 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 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 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 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 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 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 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 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 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 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 method returns a list of all user on the access list. @@access_list = $obj->access; The B 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 method returns the head revision. $head = $obj->head; The B 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 method returns a list of all revisions of archive file. @@revisions = $obj->revisions; The B 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 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 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 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 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 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 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 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 method calls the RCS ci program. # check in, and then check out in unlocked state $obj->ci('-u'); The B method calls the RCS co program. # check out in locked state $obj->co('-l'); The B method calls the RCS rcs program. # lock file $obj->rcs('-l'); The B 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 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 method calls the RCS rcsclean program. # remove working file $obj->rcsclean; =head1 EXAMPLES =head2 CREATE ACCESS LIST Using method B 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 invokes the RCS utility rcs with the same parameters. @@users = qw(beavis butthead); $obj->rcs("-a@@users"); Calling method B 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 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 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, EFE =head1 CONTRIBUTORS David Green, EFE David Green contributed the B method. Jamie O'Shaughnessy, EFE Contributed NT port. Contributed methods B, B, and B. =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 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 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 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 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 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 method returns the symbol(s) associated with a revision. a743 5 The B method returns a list of all of the symbols associated with the file. @@symbols = $obj->symbols; a758 14 The B 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 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 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 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 @ Rcs-1.05/examples/project/src/0040775000076400007640000000000007765305726015640 5ustar freterfreterRcs-1.05/examples/project/src/Rcs.pm0100644000076400007640000011174306574413263016720 0ustar freterfreterpackage Rcs; require 5.001; use strict; use Carp; use Time::Local; use vars qw($VERSION $revision); #------------------------------------------------------------------ # global stuff #------------------------------------------------------------------ $VERSION = '0.08'; $revision = '$Id: Rcs.pm,v 1.14 1998/07/23 01:00:23 freter Exp freter $'; 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 ${ $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 ${ $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 ${ $self->{"_QUIET"} }; } # access quiet mode else { return ${ $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 = ; # 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 ${ $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 = ; 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 ${ $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 () { if (/^desc$/) { $comments{0} = ''; $_ = ; s/^\@//; # remove leading '@' while (1) { last DESC if /^\@$/; s/\@\@/\@/g; # RCS replaces single '@' with '@@' $comments{0} .= $_; $_ = ; } } } # parse revision comments my $revision; REVISION: while () { if (/^[\d\.]+$/) { chomp($revision = $_); $_ = ; if (/^log$/) { $comments{$revision} = ''; $_ = ; s/^\@//; # remove leading '@' while (1) { next REVISION if /^\@$/; s/\@\@/\@/g; # RCS replaces single '@' with '@@' $comments{$revision} .= $_; $_ = ; } } } } # loop through 'text' section to avoid capturing false comments continue { if (/^text$/) { while () {last if /^\@$/} } } 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 () { 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 () { chomp; s/\s//g; # remove all whitespace push @access_list, (split(/;/))[0]; last if /;$/; } next; } # get locker # get symbols if (/^symbols$/) { while () { 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 = ; # 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 = ; 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 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 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 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 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 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 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 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 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 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 method returns a list of all user on the access list. @access_list = $obj->access; The B 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 method returns the head revision. $head = $obj->head; The B 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 method returns a list of all revisions of archive file. @revisions = $obj->revisions; The B 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 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 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 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 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 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 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 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 method calls the RCS ci program. # check in, and then check out in unlocked state $obj->ci('-u'); The B method calls the RCS co program. # check out in locked state $obj->co('-l'); The B method calls the RCS rcs program. # lock file $obj->rcs('-l'); The B 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 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 method calls the RCS rcsclean program. # remove working file $obj->rcsclean; =head1 EXAMPLES =head2 CREATE ACCESS LIST Using method B 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 invokes the RCS utility rcs with the same parameters. @users = qw(beavis butthead); $obj->rcs("-a@users"); Calling method B 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 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 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, EFE =head1 CONTRIBUTORS David Green, EFE David Green contributed the B method. Jamie O'Shaughnessy, EFE Contributed NT port. Contributed methods B, B, and B. =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 Rcs-1.05/examples/project/src/testfile0100644000076400007640000000002006574605556017366 0ustar freterfreter3.14 hear again Rcs-1.05/examples/access.pl0100755000076400007640000000075606573410000015161 0ustar freterfreter#!/usr/local/bin/perl -w #------------------------------------------ # Add users to access list. #------------------------------------------ use strict; use Rcs; Rcs->bindir('/usr/bin'); Rcs->quiet(0); my $obj = Rcs->new; $obj->rcsdir("./project/RCS"); $obj->workdir("./project/src"); $obj->file("testfile"); my @users = qw(beavis butthead); $obj->rcs("-a@users"); my $filename = $obj->file; my @access_list = $obj->access; print "Users @access_list are on the access list of $filename\n"; Rcs-1.05/examples/ci.pl0100755000076400007640000000107306574372041014321 0ustar freterfreter#!/usr/local/bin/perl -w #------------------------------------------ # Check-in source file. #------------------------------------------ use strict; use Rcs; Rcs->bindir('/usr/bin'); Rcs->quiet(0); # turn off quiet mode my $obj = Rcs->new; print "Quiet mode set\n" if Rcs->quiet; $obj->rcsdir("./project/RCS"); $obj->workdir("./project/src"); $obj->file("testfile"); # archive file exists if (! -e $obj->rcsdir . '/' . $obj->arcfile) { print "Initial Check-in\n"; $obj->ci("-u"); } # create archive file else { print "Check-in\n"; $obj->ci("-l"); } Rcs-1.05/examples/co-tree.pl0100755000076400007640000000150206573410002015246 0ustar freterfreter#!/usr/bin/perl -w use strict; use File::Find; use File::Path; use Rcs; Rcs->bindir("/usr/bin"); my $lock = 0; # Traverse desired filesystems my $tree_root = '/home/freter/tmp'; my $rcs_path = '/RCS'; my $chkpt_path = '/chkpt'; find(\&wanted, $tree_root . $rcs_path); exit; sub wanted { my $relative_path = $File::Find::dir; ($relative_path) =~ s{^$tree_root$rcs_path}{}; print $relative_path; print "\n"; mkpath([$tree_root . $chkpt_path . $relative_path], 1, 0755); return unless -f; my $obj = Rcs->new; s/,v$//; $obj->file($_); $obj->rcsdir($tree_root . $rcs_path . $relative_path); $obj->workdir($tree_root . $chkpt_path . $relative_path); # check out and lock if ($lock) { $obj->co("-l"); } # check out read only else { $obj->co; } } Rcs-1.05/examples/co.pl0100755000076400007640000000101606574372062014327 0ustar freterfreter#!/usr/local/bin/perl -w #------------------------------------------ # Check-out source file. #------------------------------------------ use strict; use Rcs; Rcs->bindir('/usr/bin'); Rcs->quiet(0); # turn off quiet mode my $obj = Rcs->new; print "Quiet mode set\n" if Rcs->quiet; $obj->rcsdir("./project/RCS"); $obj->workdir("./project/src"); $obj->file("testfile"); my $revision = shift || $obj->head; die "Revision $revision does not exist\n" unless grep /^$revision$/, $obj->revisions; $obj->co("-l${revision}"); Rcs-1.05/examples/comments.pl0100755000076400007640000000111406573410004015536 0ustar freterfreter#!/usr/local/bin/perl -w #------------------------------------------ # Access comments hash #------------------------------------------ use strict; use lib '.'; use Rcs; Rcs->bindir('/usr/bin'); my $obj = Rcs->new; $obj->rcsdir("./project/RCS"); $obj->workdir("./project/src"); $obj->file("testfile"); my %comments = $obj->comments; my $revision; foreach $revision (keys %comments) { #my $comments = $comments{$revision} ? $comments{$revision} : 'GGG'; my $comments = $comments{$revision}; print "======\n"; print "Revision: $revision\n"; print "$comments###\n"; } Rcs-1.05/examples/comments2.pl0100755000076400007640000000111706574413402015631 0ustar freterfreter#!/usr/local/bin/perl -w #------------------------------------------ # Access comments hash #------------------------------------------ use strict; use lib '.'; use Rcs; Rcs->bindir('/usr/bin'); my $obj = Rcs->new; $obj->rcsdir("./project/RCS"); $obj->workdir("./project/src"); $obj->file("Rcs.pm"); my %comments = $obj->comments; my $revision; foreach $revision (sort keys %comments) { #my $comments = $comments{$revision} ? $comments{$revision} : 'GGG'; my $comments = $comments{$revision}; print "======\n"; print "Revision: $revision\n"; print "$comments###\n"; } Rcs-1.05/examples/daterev.pl0100755000076400007640000000246206574774445015401 0ustar freterfreter#!/usr/local/bin/perl -w #------------------------------------------ # Test daterev method #------------------------------------------ use strict; use Time::Local; use lib '.'; use Rcs; Rcs->bindir('/usr/bin'); my $obj = Rcs->new; $obj->rcsdir("./project/RCS"); $obj->workdir("./project/src"); $obj->file("testfile"); my @date_array = @ARGV; my($year, $mon, $mday, $hour, $min, $sec) = @date_array; $mon--; # convert to 0-11 range my $target_time = timegm($sec, $min, $hour, $mday, $mon, $year); print "Called as 6 argument method\n"; # scalar mode my $revision = $obj->daterev(@date_array); my $date_str = gmtime($obj->revdate($revision)); print "Date : Revision = $date_str : $revision\n\n"; # list mode print "List mode\n"; my @revisions = $obj->daterev(@date_array); foreach (@revisions) { $date_str = gmtime($obj->revdate($_)); print "Date : Revision = $date_str : $_\n"; } print "\n\n\n"; print "Called as 1 argument method\n"; print "Time number is $target_time\n"; $revision = $obj->daterev($target_time); $date_str = gmtime($obj->revdate($revision)); print "Date : Revision = $date_str : $revision\n\n"; # list mode print "List mode\n"; @revisions = $obj->daterev($target_time); foreach (@revisions) { $date_str = gmtime($obj->revdate($_)); print "Date : Revision = $date_str : $_\n"; } Rcs-1.05/examples/dates.pl0100755000076400007640000000150006573410005015011 0ustar freterfreter#!/usr/local/bin/perl -w #------------------------------------------ # Access dates hash #------------------------------------------ use strict; use Rcs; #Rcs->bindir('/usr/bin'); my $obj = Rcs->new; $obj->rcsdir("./project/RCS"); $obj->workdir("./project/src"); $obj->file("testfile"); # sort by date my %dates_hash = $obj->dates; my $revision; my %dates; 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} }) { my $date_str = localtime($date); print "Revision : Date = $revision : $date_str\n"; } } # scalar mode returns most recent date print "\n"; my $most_recent = localtime($obj->dates); print "Most recent revision date = $most_recent\n"; Rcs-1.05/examples/parse.pl0100755000076400007640000000150507766207332015044 0ustar freterfreter#!/usr/local/bin/perl -w #------------------------------------------ # Parse RCS archive file. #------------------------------------------ use strict; use Rcs; Rcs->bindir('/usr/bin'); my $obj = Rcs->new; $obj->rcsdir("./project/RCS"); $obj->workdir("./project/src"); $obj->file("testfile"); my $head_rev = $obj->head; my $locker = $obj->lock; my $author = $obj->author; my @access = $obj->access; my @revisions = $obj->revisions; my $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 (@revisions) { print "Revision: $_\n"; } Rcs-1.05/examples/rcsclean.pl0100755000076400007640000000061306573410024015510 0ustar freterfreter#!/usr/local/bin/perl -w #------------------------------------------ # rcsclean utility #------------------------------------------ use strict; use Rcs; Rcs->quiet(0); # turn off quiet mode Rcs->bindir('/usr/bin'); my $obj = Rcs->new; print "Quiet mode NOT set\n" unless Rcs->quiet; $obj->rcsdir("./project/RCS"); $obj->workdir("./project/src"); $obj->file("testfile"); $obj->rcsclean; Rcs-1.05/examples/rcsdiff.pl0100755000076400007640000000113406573410024015335 0ustar freterfreter#!/usr/local/bin/perl -w #------------------------------------------ # Use rcsdiff utility. #------------------------------------------ use strict; use Rcs; Rcs->quiet(1); my $obj = Rcs->new; $obj->bindir('/usr/bin'); print "Quiet mode set\n" if Rcs->quiet; $obj->rcsdir("./project/RCS"); $obj->workdir("./project/src"); $obj->file("testfile"); 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'); Rcs-1.05/examples/revdate.pl0100755000076400007640000000134206573410035015352 0ustar freterfreter#!/usr/local/bin/perl -w #------------------------------------------ # Get revision date #------------------------------------------ use strict; use Rcs; Rcs->bindir('/usr/bin'); my $obj = Rcs->new; $obj->rcsdir("./project/RCS"); $obj->workdir("./project/src"); $obj->file("testfile"); my $revision = shift || $obj->head; die "Revision $revision does not exist\n" unless grep /^$revision$/, $obj->revisions; # scalar mode my $date_num = $obj->revdate($revision); print "Revision : Date number = $revision : $date_num\n"; my $date_str = localtime($date_num); print "Revision : Date string = $revision : $date_str\n"; # list mode my @list_date = $obj->revdate($revision); print "Revision : Date array = $revision : @list_date\n"; Rcs-1.05/examples/rlog.pl0100755000076400007640000000063006574372002014664 0ustar freterfreter#!/usr/local/bin/perl -w #------------------------------------------ # Use rlog utility. #------------------------------------------ use strict; use Rcs; my $obj = Rcs->new; # call quiet and bindir as objest methods $obj->quiet(1); $obj->bindir('/usr/bin'); print "Quiet mode set\n" if Rcs->quiet; $obj->rcsdir("./project/RCS"); $obj->workdir("./project/src"); $obj->file("testfile"); print $obj->rlog; Rcs-1.05/examples/symbols.pl0100755000076400007640000000074206573410036015414 0ustar freterfreter#!/usr/local/bin/perl -w #------------------------------------------ # Test symrev method #------------------------------------------ use strict; use Rcs; Rcs->bindir('/usr/bin'); my $obj = Rcs->new; $obj->rcsdir("./project/RCS"); $obj->workdir("./project/src"); $obj->file("testfile"); my %symbols = $obj->symbols; my $sym; foreach $sym (keys %symbols) { my $rev = $symbols{$sym}; print "Symbol : Revision = $sym : $rev\n"; } my @syms = keys %symbols; print "@syms\n"; Rcs-1.05/examples/symrev.pl0100755000076400007640000000116006573410037015245 0ustar freterfreter#!/usr/local/bin/perl -w #------------------------------------------ # Test symrev method #------------------------------------------ use strict; use Rcs; #Rcs->bindir('/usr/bin'); my $obj = Rcs->new; $obj->rcsdir("./project/RCS"); $obj->workdir("./project/src"); $obj->file("testfile"); (my $symbol = shift) or die "Usage: $0 symbol\n"; # scalar mode print "Scalar mode:\n"; my $revision = $obj->symrev($symbol); print "Symbol : Revision = $symbol : $revision\n"; # list mode print "\nList mode:\n"; my %symbols = $obj->symrev($symbol); foreach (keys %symbols) { print "Symbol : Revision = $_ : $symbols{$_}\n"; } Rcs-1.05/examples/test1.pl0100755000076400007640000000027706573410040014762 0ustar freterfreter#!/usr/local/bin/perl -w use strict; use lib '.'; use Rcs; my $p = new Rcs(); $p->workdir("foo"); my $n = new Rcs(); $n->workdir("bar"); print $p->workdir, "\n"; print $n->workdir, "\n"; Rcs-1.05/examples/test2.pl0100755000076400007640000000030206573410041014751 0ustar freterfreter#!/usr/local/bin/perl -w use strict; use lib '.'; use Rcs; Rcs->workdir("foo"); my $p = new Rcs(); my $n = new Rcs(); Rcs->workdir("bar"); print $p->workdir, "\n"; print $n->workdir, "\n"; Rcs-1.05/examples/test3.pl0100755000076400007640000000035506573410042014763 0ustar freterfreter#!/usr/local/bin/perl -w use strict; use lib '.'; use Rcs; my $p = new Rcs(); my $n = new Rcs(); my $m = new Rcs(); $m->workdir("foo"); Rcs->workdir("bar"); print $p->workdir, "\n"; print $n->workdir, "\n"; print $m->workdir, "\n"; Rcs-1.05/examples/unlock.pl0100755000076400007640000000071106573410046015214 0ustar freterfreter#!/usr/local/bin/perl -w #------------------------------------------ # Unlock RCS file #------------------------------------------ use strict; use Rcs; Rcs->bindir('/usr/bin'); Rcs->quiet(0); my $obj = Rcs->new; $obj->rcsdir("./project/RCS"); $obj->workdir("./project/src"); $obj->file("testfile"); my $revision = shift || $obj->head; die "Revision $revision does not exist\n" unless grep /^$revision$/, $obj->revisions; $obj->rcs("-u${revision}"); Rcs-1.05/Makefile.PL0100664000076400007640000000034106612700100013501 0ustar freterfreteruse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Rcs', 'VERSION_FROM' => 'Rcs.pm', # finds $VERSION ); Rcs-1.05/ANNOUNCE0100664000076400007640000000174007765306557012720 0ustar freterfreterA programming project required the creation of a Revision Control System (RCS) front end. I started with inline system calls to the RCS utilities, and by creating multiple parsing functions to extract information from an RCS archive file. I then decided to put all my functions in one place, and created Perl module Rcs.pm. The next step was to change my functions into object methods, and Rcs.pm became object oriented. This Perl module should be of interest to anyone creating an RCS front end. Here's a quick and dirty example of how to check in a file. use Rcs; $obj = Rcs->new; $obj->file('testfile.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"); $obj->ci('-mRevision Comment'); If there's any interest, I would like to make Rcs.pm publicly available. Please let me know is you have any suggestions or comments. Craig Freter Rcs-1.05/Changes0100664000076400007640000000101607765306764013056 0ustar freterfreterRevision history for Perl extension Rcs. 0.01 Mon Oct 19 14:09:04 1998 - original version; created by h2xs 1.18 1.01 Wed Oct 3 19:59:38 EDT 2001 - added nonFatal Verbose tags 1.02 Fri Oct 19 16:57:55 EDT 2001 - fixed bug in lock method 1.03 Sat Nov 3 18:55:19 EST 2001 - fixed another bug in lock method discovered by Michael Keller 1.04 Fri May 17 00:01:15 EDT 2002 - Method rcsmerge contributed by Wim Kerkhoff 1.05 Tue Dec 9 03:54:07 EST 2003 - fixed bug reported by Henry (Hank) B. Ivy Rcs-1.05/MANIFEST0100664000076400007640000000104307765306461012706 0ustar freterfreterANNOUNCE Changes examples/project/RCS/testfile,v examples/project/RCS/Rcs.pm,v examples/project/src/Rcs.pm examples/project/src/testfile examples/access.pl examples/ci.pl examples/co-tree.pl examples/co.pl examples/comments.pl examples/comments2.pl examples/daterev.pl examples/dates.pl examples/parse.pl examples/rcsclean.pl examples/rcsdiff.pl examples/revdate.pl examples/rlog.pl examples/symbols.pl examples/symrev.pl examples/test1.pl examples/test2.pl examples/test3.pl examples/unlock.pl Makefile.PL MANIFEST Rcs.html Rcs.pm README test.pl Rcs-1.05/README0100664000076400007640000000242107766474532012444 0ustar freterfreterThis is Perl Object Class Rcs.pm 1.05, a front-end to Revision Contron System (RCS) Utilities. Version 1.05: Bug fix in parsing locking information. New in Version 1.04: Method rcsmerge New in Version 1.02: Bug fixes. New in Version 1.01: use Rcs qw(nonFatal Verbose); Use tags to control how the rcs programs handle errors, and the use of the rcs -q (quiet) flag. The default behavior is to run rcs programs with the -q (quiet) flag, and to die if any rcs program returns an error. New in Version 0.07: NT port by Jamie O'Shaughnessy, Added methods 'daterev', 'symrev', and 'symbols' contributed by Jamie O'Shaughnessy. Added method 'comments'. New in Version 0.08: Fixed bug parsing comments. Bug found by David Green Modified daterev method to accept 1 or 6 arguments. New in Version 0.09: Fixed bug parsing comments. Bug found by David Green Install Rcs.pm as you would any Perl 5 module: perl Makefile.PL make make install The documentation is contained in Rcs.pm in pod format. The man pages will install automatically, or may be extracted manually by: pod2man Rcs.pm > Rcs.man Please let me know is you have any suggestions or comments. Craig Freter Rcs-1.05/Rcs.html0100664000076400007640000004601407766474447013214 0ustar freterfreter Rcs - Perl Object Class for Revision Control System.

NAME

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

SYNOPSIS

    use Rcs;
    # Use tags to control how the rcs programs handle errors
    # and the use of the rcs -q (quiet) flag.
    use Rcs qw(nonFatal Verbose);

The default behavior is to run rcs programs with the -q (quiet) flag, and to die if any rcs program returns an error.

DESCRIPTION

This Perl module provides an object oriented interface to access 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.

OBJECT CONSTRUCTOR

The 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;

Note: You may now set the pathname of the working file through the object constructor. This is the same as calling the pathname method after calling the new method.

Thus

    $obj = Rcs->new($pathname);

is the same as

    $obj = Rcs->new;
    $obj->pathname($pathname);

See pathname method for additional details.

CLASS METHODS

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

The 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 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 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);

OBJECT ATTRIBUTE METHODS

These methods set the attributes of the RCS object.

The 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 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 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 rcsdir methods set the path of the RCS archive directory. If not specified, default path is './RCS'.

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

The pathname method will set both the working filename and archive directory.

    $obj->pathname($RCS_DIR . '/' . 'butthead.c');
and
    $obj->pathname($RCS_DIR . '/' . 'butthead.c,v');

are the same as

    $obj->rcsdir($RCS_DIR);
    $obj->file('butthead.c');

RCS PARSE METHODS

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

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

    @access_list = $obj->access;

The 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 head method returns the head revision.

    $head = $obj->head;

The 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. When called in list context the lock method returns a hash of all locks.

    # returns locker of revision '1.3'
    $locker = $obj->lock('1.3');
    # returns locker of head revision
    $locker = $obj->lock;
    # return hash of all locks
    %locks = $obj->lock;    # called in list context
    foreach $rev (keys %locks) {
        $locker = $locks{$rev};
        print "User $locker has revision $rev locked\n";
    }

The revisions method returns a list of all revisions of archive file.

    @revisions = $obj->revisions;

The 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 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 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 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 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 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 = $obj->symrev('MY_SYMBOL');

The daterev method returns revisions which were created before a specified date. Method may take one or six arguments. If one arguments is passed, then the argument is a date number. If six arguments are passed, then they represent a date string.

    # one argument, date number
    # gets revisions created before Sun Sep  6 22:23:47 1998
    @revs = $obj->daterev(841436420);
    # six argument
    # gets revisions created before 25th June 1998 16:45:30
    @revs = $obj->daterev(1998, 6, 25, 16, 45, 30);

The 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'};

RCS SYSTEM METHODS

These methods invoke the RCS system utilities.

The ci method calls the RCS ci program.

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

The co method calls the RCS co program.

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

The rcs method calls the RCS rcs program.

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

The 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 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 rcsclean method calls the RCS rcsclean program.

    # remove working file
    $obj->rcsclean;

EXAMPLES

CREATE ACCESS LIST

Using method rcs with the -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 rcs invokes the RCS utility rcs with the same parameters.

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

Calling method 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";

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";
    }

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 -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 revision comment.

Command:

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

is equivalent to commands:

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

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');

RCSDIFF

Method 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');

RCSCLEAN

Method 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;

AUTHOR

Craig Freter, <craig@freter.com>

CONTRIBUTORS

David Green, <greendjf@cvhp152.gpt.marconicomms.com>

Jamie O'Shaughnessy, <jamie@thanatar.demon.co.uk>

Raju Krishnamurthy, <raju_k@iname.com>

COPYRIGHT

Copyright (C) 1997,2003 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.

Rcs-1.05/Rcs.pm0100664000076400007640000012264007766474435012661 0ustar freterfreterpackage Rcs; require 5.002; use strict; use Exporter; use Carp; use Time::Local; use vars qw($VERSION $revision); use subs qw(_rcsError); # Even though I don't really export anything, I use Exporter # to look for 'nonFatal' 'Verbose' tags. use vars qw(@ISA @EXPORT_OK); @ISA = qw(Exporter); @EXPORT_OK = qw(nonFatal Verbose); #------------------------------------------------------------------ # global stuff #------------------------------------------------------------------ $VERSION = '1.05'; $revision = '$Id: Rcs.pm,v 1.28 2003/12/12 00:53:34 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 $nonFatal = 0; # default to fatal 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); # Allow user to pass archive file to object constructor # Example: Rcs->new('RCS/diskio.c,v') if (@_) { $self->pathname(shift); } return $self; } #------------------------------------------------------------------ # Use import function to check for 'nonFatal' Tag. #------------------------------------------------------------------ sub import { my $pkg = shift; $nonFatal = 1 if scalar grep /^nonFatal$/, @_; $Quiet = 0 if scalar grep /^Verbose$/, @_; } #------------------------------------------------------------------ # 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; my $archive_file = $rcsdir . $Dir_Sep . $arcfile; my $workfile = $workdir . $Dir_Sep . $file; push @param, $archive_file, $workfile; unshift @param, "-q" if $self->quiet; # quiet mode # run program return(_rcsError "ci program $ciprog not found") unless -e $ciprog; return(_rcsError "ci program $ciprog not executable") unless -x $ciprog; system($ciprog, @param) == 0 or return(_rcsError "$?"); # re-parse RCS file and clear comments hash _parse_rcs_header($self); $self->{COMMENTS} = undef; return 1; } #------------------------------------------------------------------ # 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; my $archive_file = $rcsdir . $Dir_Sep . $arcfile; my $workfile = $workdir . $Dir_Sep . $file; push @param, $archive_file, $workfile; unshift @param, "-q" if $self->quiet; # quiet mode # run program return(_rcsError "co program $coprog not found") unless -e $coprog; return(_rcsError "co program $coprog not executable") unless -x $coprog; system($coprog, @param) == 0 or return(_rcsError "$?"); # re-parse RCS file and clear comments hash _parse_rcs_header($self); $self->{COMMENTS} = undef; return 1; } #------------------------------------------------------------------ # comments #------------------------------------------------------------------ sub comments { my $self = shift; if (not defined $self->{COMMENTS}) { _parse_rcs_body($self); } return %{$self->{COMMENTS}}; } #------------------------------------------------------------------ # daterev # # Returns revisions which were created before a specified date. # # Method takes one or six arguments. # # If one argument, then argument is date number. # # If six arguments, then 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 $target_time; # validate arguments unless (@_ == 1 or @_ == 6) { croak "daterev must have either 1 or 6 arguments"; } # string date passed if (@_ == 6) { my($year, $mon, $mday, $hour, $min, $sec) = @_; if($year !~ /^\d{4}$/) { croak "year (1st param) must be 4 digit number"; } $mon--; # convert to 0-11 range $target_time = timegm($sec, $min, $hour, $mday, $mon, $year); } # system date passed else { $target_time = shift; if ($target_time !~ /^\d+$/) { croak "system date must be an integer"; } } if (not defined $self->{DATE}) { _parse_rcs_header($self); } my @revisions = (); my %dates; my %dates_hash = %{$self->{DATE}}; my $revision; 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}; } #------------------------------------------------------------------ # pathname # Full name of working file, including path to it and RCS file extension. # Sets the location of 'RCS' archive directory. #------------------------------------------------------------------ sub pathname { my $self = shift; if (@_) { my $filename = shift; if ($filename =~ m/(.*)$Dir_Sep(.*)/) { $self->rcsdir($1); $filename = $2; } else { $self->rcsdir('.'); } # Strip off archive extension if exists my $arcext = $self->arcext; $filename =~ s/$arcext$//; $self->file($filename); } return $self->rcsdir . $Dir_Sep . $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); } my $revision = shift || $self->{HEAD}; return wantarray ? %{ $self->{LOCK} } : ${ $self->{LOCK} }{$revision}; } #------------------------------------------------------------------ # 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; my $archive_file = $rcsdir . $Dir_Sep . $arcfile; my $workfile = $workdir . $Dir_Sep . $file; push @param, $archive_file, $workfile; unshift @param, "-q" if $self->quiet; # quiet mode # run program return(_rcsError "rcs program $rcsprog not found") unless -e $rcsprog; return(_rcsError "rcs program $rcsprog not executable") unless -x $rcsprog; system($rcsprog, @param) == 0 or return(_rcsError "$?"); # re-parse RCS file and clear comments hash _parse_rcs_header($self); $self->{COMMENTS} = undef; return 1; } #------------------------------------------------------------------ # 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; my $archive_file = $rcsdir . $Dir_Sep . $arcfile; my $workfile = $workdir . $Dir_Sep . $file; push @param, $archive_file, $workfile; # run program return(_rcsError "rcsclean program $rcscleanprog not found") unless -e $rcscleanprog; return(_rcsError "rcsclean program $rcscleanprog not executable") unless -x $rcscleanprog; system($rcscleanprog, @param) == 0 or return(_rcsError "$?"); # re-parse RCS file and clear comments hash _parse_rcs_header($self); $self->{COMMENTS} = undef; return 1; } #------------------------------------------------------------------ # 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; $arcfile = $rcsdir . $Dir_Sep . $arcfile; 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; return(_rcsError "rcsdiff program $rcsdiff_prog not found") unless -e $rcsdiff_prog; return(_rcsError "rcsdiff program $rcsdiff_prog not executable") unless -x $rcsdiff_prog; open(DIFF, "$rcsdiff_prog $param_str $arcfile $workfile |") or return(_rcsError "Can't fork $rcsdiff_prog: $!"); my @diff_output = ; # rcsdiff returns exit status 0 for no differences, 1 for differences, # and 2 for error condition. close DIFF; my $status = $?; $status >>= 8; return(_rcsError "$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; return(_rcsError "rlog program $rlogprog not found") unless -e $rlogprog; return(_rcsError "rlog program $rlogprog not executable") unless -x $rlogprog; open(RLOG, "$rlogprog $param_str $archive_file |") or return(_rcsError "Can't fork $rlogprog: $!"); my @logoutput = ; close RLOG; return(_rcsError "$rlogprog failed") if $?; @logoutput; } #------------------------------------------------------------------ # rcsmerge # Execute RCS 'rcsmerge' program. #------------------------------------------------------------------ sub rcsmerge { my $self = shift; my @param = @_; my $rcsmergeprog = $self->bindir . $Dir_Sep . 'rcsmerge' . $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; return(_rcsError "rcsmerge program $rcsmergeprog not found") unless -e $rcsmergeprog; return(_rcsError "rcsmerge program $rcsmergeprog not executable") unless -x $rcsmergeprog; open(RCSMERGE, "$rcsmergeprog $param_str $archive_file |") or return(_rcsError "Can't fork $rcsmergeprog $!"); my @logoutput = ; close RCSMERGE; return(_rcsError "$rcsmergeprog 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 # Return symbol(s) based on revision. #------------------------------------------------------------------ sub symbol { my $self = shift; my $sym; my @sym_array; if (not defined $self->{SYMBOLS}) { _parse_rcs_header($self); } my $revision = shift || $self->head; # dereference symbols hash my %symbols = %{ $self->{SYMBOLS} }; foreach $sym (keys %symbols) { my $rev = $symbols{$sym}; push @sym_array, $sym if $rev eq $revision; } # return only first array element if user wants scalar return wantarray ? @sym_array : $sym_array[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); } return %{$self->{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 or croak "You must supply a symbol to symrev";; if (not defined $self->{SYMBOLS}) { _parse_rcs_header($self); } my %symbols = %{ $self->{SYMBOLS} }; my $revision = $symbols{$sym} ? $symbols{$sym} : 0; my %matched_symbols = map { $_ => $symbols{$_} } grep(/$sym/, keys %symbols); return wantarray ? %matched_symbols : $revision; } #------------------------------------------------------------------ # 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 return(_rcsError "Unable to open $rcs_file: $!"); # skip header info and get description DESC: while () { if (/^desc$/) { $comments{0} = ''; $_ = ; # read first line s/^\@//; # remove leading '@' while (1) { last DESC if /^\@$/; s/\@\@/\@/g; # RCS replaces single '@' with '@@' $comments{0} .= $_; $_ = ; } } } # parse revision comments my $revision; REVISION: while () { if (/^[\d\.]+$/) { chomp($revision = $_); $_ = ; if (/^log$/) { $comments{$revision} = ''; $_ = ; # read first line s/^\@//; # remove leading '@' while (1) { next REVISION if /^\@$/; s/\@\@/\@/g; # RCS replaces single '@' with '@@' $comments{$revision} .= $_; $_ = ; } } } } # loop through 'text' section to avoid capturing bogus info continue { if (/^text$/) { # 'text' tag should always be there, but check anyway $_ = ; # read first line if (not /^\@\@$/) { # forced revisions have single '@@' in text section while () { s/\@\@//g; # RCS replaces single '@' with '@@' last if /\@$/ } } } } 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 return(_rcsError "Unable to open $rcs_file: $!"); while () { 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 () { chomp; s/\s//g; # remove all whitespace push @access_list, (split(/;/))[0]; last if /;$/; } next; } # get symbols if (/^symbols$/) { while () { chomp; s/\s//g; # remove all whitespace my ($sym, $rev) = split(/:/); $rev =~ s/;$//; $symbols{$sym} = $rev; last if /;$/; } next; } # get locker if (/^locks/) { # file not locked if (/;$/) { %lock = (); next; } # get user who has file locked while() { s/\s+//g; # remove all white space next unless $_ ; # skip blank line (now empty string) last if /^;/; # end of locks my ($locker, $rev) = split(/:/); $rev =~ s/;.*//; $lock{$rev} = $locker; last if /;$/; # end of locks } next; } # get all revisions if (/^\d+\.\d+/) { chomp; push @revisions, $_; # get author, state and date of each revision my $next_line = ; 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; } #------------------------------------------------------------------ # _rcsError #------------------------------------------------------------------ sub _rcsError { my $error_msg = shift; not $nonFatal and croak $error_msg; $nonFatal and not $Quiet and carp $error_msg and return 0; $nonFatal and $Quiet and return 0; } 1; __END__ =head1 NAME Rcs - Perl Object Class for Revision Control System (RCS). =head1 SYNOPSIS use Rcs; # Use tags to control how the rcs programs handle errors # and the use of the rcs -q (quiet) flag. use Rcs qw(nonFatal Verbose); The default behavior is to run rcs programs with the -q (quiet) flag, and to die if any rcs program returns an error. =head1 DESCRIPTION This Perl module provides an object oriented interface to access B 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 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; Note: You may now set the pathname of the working file through the object constructor. This is the same as calling the pathname method after calling the new method. Thus $obj = Rcs->new($pathname); is the same as $obj = Rcs->new; $obj->pathname($pathname); See B method for additional details. =head2 CLASS METHODS Besides the object constructor, there are three class methods provided which effect any newly created objects. The B 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 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 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 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 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 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 methods set the path of the RCS archive directory. If not specified, default path is './RCS'. $obj->rcsdir('/usr/local/archive'); The B method will set both the working filename and archive directory. $obj->pathname($RCS_DIR . '/' . 'butthead.c'); and $obj->pathname($RCS_DIR . '/' . 'butthead.c,v'); are the same as $obj->rcsdir($RCS_DIR); $obj->file('butthead.c'); =head2 RCS PARSE METHODS This class provides methods to directly parse the RCS archive file. The B method returns a list of all user on the access list. @access_list = $obj->access; The B 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 method returns the head revision. $head = $obj->head; The B 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. When called in list context the lock method returns a hash of all locks. # returns locker of revision '1.3' $locker = $obj->lock('1.3'); # returns locker of head revision $locker = $obj->lock; # return hash of all locks %locks = $obj->lock; # called in list context foreach $rev (keys %locks) { $locker = $locks{$rev}; print "User $locker has revision $rev locked\n"; } The B method returns a list of all revisions of archive file. @revisions = $obj->revisions; The B 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 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 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 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 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 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 = $obj->symrev('MY_SYMBOL'); The B method returns revisions which were created before a specified date. Method may take one or six arguments. If one arguments is passed, then the argument is a date number. If six arguments are passed, then they represent a date string. # one argument, date number # gets revisions created before Sun Sep 6 22:23:47 1998 @revs = $obj->daterev(841436420); # six argument # gets revisions created before 25th June 1998 16:45:30 @revs = $obj->daterev(1998, 6, 25, 16, 45, 30); The B 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 method calls the RCS ci program. # check in, and then check out in unlocked state $obj->ci('-u'); The B method calls the RCS co program. # check out in locked state $obj->co('-l'); The B method calls the RCS rcs program. # lock file $obj->rcs('-l'); The B 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 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 method calls the RCS rcsclean program. # remove working file $obj->rcsclean; =head1 EXAMPLES =head2 CREATE ACCESS LIST Using method B 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 invokes the RCS utility rcs with the same parameters. @users = qw(beavis butthead); $obj->rcs("-a@users"); Calling method B 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 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 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, EFE =head1 CONTRIBUTORS David Green, EFE Jamie O'Shaughnessy, EFE Raju Krishnamurthy, EFE =head1 COPYRIGHT Copyright (C) 1997,2003 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 Rcs-1.05/test.pl0100664000076400007640000000121006612700100013037 0ustar freterfreter# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..1\n"; } END {print "not ok 1\n" unless $loaded;} use Rcs; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code):