From bd91df39885fd00f405198f1853d111e7b405e2e Mon Sep 17 00:00:00 2001 From: Laura Arjona Reina Date: Tue, 2 Apr 2019 16:32:42 +0200 Subject: remove Perl libraries related to CVS, not needed anymore --- Perl/Local/Cvsinfo.pm | 379 ---------------------------- Perl/Local/VCS_CVS.pm | 679 -------------------------------------------------- 2 files changed, 1058 deletions(-) delete mode 100644 Perl/Local/Cvsinfo.pm delete mode 100644 Perl/Local/VCS_CVS.pm (limited to 'Perl') diff --git a/Perl/Local/Cvsinfo.pm b/Perl/Local/Cvsinfo.pm deleted file mode 100644 index 3e798917e86..00000000000 --- a/Perl/Local/Cvsinfo.pm +++ /dev/null @@ -1,379 +0,0 @@ -#!/usr/bin/perl -w - -## Copyright (C) 2001 Denis Barbier -## -## This program is free software; you can redistribute it and/or modify -## it under the terms of the GNU General Public License as published by -## the Free Software Foundation; either version 2 of the License, or -## (at your option) any later version. - -=head1 NAME - -Local::Cvsinfo - retrieve CVS related informations from a checked out copy - -=head1 SYNOPSIS - - use Local::Cvsinfo; - my $cvs = Local::Cvsinfo->new(); - $cvs->readinfo('.', recursive => 1, verbose => 1 ); - my $top = $cvs->topdir(); - my $rev = $cvs->revision('foo/bar'); - -=head1 DESCRIPTION - -This module retrieves CVS related informations from a checked out -working directory, by scanning the F files found within. - -=head1 METHODS - -=over 4 - -=cut - -package Local::Cvsinfo; -use Carp; -use strict; - -=item new - -This is the constructor. - - my $cvs = Local::Cvsinfo->new(); - -=cut - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = { - TOP => '', - IGNORE => [], - DIRS => [], - FILES => {}, - GLOBAL_OPTIONS => {}, - SKIP => sub {}, - }; - bless ($self, $class); - return $self; -} - -=item options - -Without arguments, return a reference to a hash array containing the -list of options. -If there is an argument, set some global options for the timelife of -this object. Argument is a hash array, currently C, -C, C and C keys are recognized. Processing -is recursive (resp. verbose) if C (resp. C) is set -to a non-null value. The C and C values must be -arrays containing Perl regular expressions, the former specifies -directory to skip in recursive mode (C directories are always -skipped), and the latter specifies which files do match (default: all). - - $cvs->options(recursive => 1, matchfile => [ '\.c$' ]); - while (($key, $val) = each %{$cvs->options()}) { - print $key . ":" . $val . "\n"; - } - -=cut - -sub options { - my $self = shift; - my %arg = @_; - if (!@_) { - return $self->{GLOBAL_OPTIONS}; - } - $self->{GLOBAL_OPTIONS} = \%arg; - $self->{GLOBAL_OPTIONS}->{matchfile} ||= [ '' ]; - $self->{OPTIONS} = $self->{GLOBAL_OPTIONS}; - $self->_fix_skip(); -} - -sub _verbose { - my $self = shift; - return unless $self->{OPTIONS}->{verbose}; - print STDERR "Verbose: ".$_[0] . "\n"; -} - -=item readinfo - -This is where processing is done. First argument is a directory name, -the F and F files will be searched in that -directory and informations on entries defined within are internally -stored, unless this entry has been discarded by an C attribute. -Optional remaining arguments are a hash array overriding global options. - - $cvs->readinfo("src"); - $cvs->readinfo("src", recursive => 1); - -=cut - -sub readinfo { - my $self = shift; - my $dir = shift; - my %options = @_; - my @heredir = (); - my ($entry, $oldoptions, $line); - - $dir =~ s|/+$||; - -r $dir."/CVS/Entries" or do { - carp "Unable to read file $dir/CVS/Entries ... skipped"; - return; - }; - -r $dir."/CVS/Repository" or do { - carp "Unable to read file $dir/CVS/Repository ... skipped"; - return; - }; - - # Set options - $oldoptions = $self->{OPTIONS}; - $self->{OPTIONS} = $self->{GLOBAL_OPTIONS}; - if (%options) { - foreach (keys %options) { - $self->{OPTIONS}->{$_} = $options{$_}; - } - } - $self->_fix_skip() - unless ref($oldoptions->{skipdir}) eq "ARRAY" - and ref($oldoptions->{matchfile}) eq "ARRAY" - and ref($self->{OPTIONS}->{skipdir}) eq "ARRAY" - and ref($self->{OPTIONS}->{matchfile}) eq "ARRAY" - and join("\n", $oldoptions->{skipdir}) eq join("\n", $self->{OPTIONS}->{skipdir}) - and join("\n", $oldoptions->{matchfile}) eq join("\n", $self->{OPTIONS}->{matchfile}); - - # Read CVS/Repository and CVS/Root to determine top-level - # directory - open(REP, "< $dir/CVS/Repository") - or croak "Unable to read file $dir/CVS/Repository\n"; - $self->_verbose("Reading $dir/CVS/Repository"); - $line = ; - close(REP); - if ($line =~ m#^/#) { - # Absolute path, we must read CVS/Root - open(ROOT, "< $dir/CVS/Root") - or croak "Unable to read file $dir/CVS/Root\n"; - $self->_verbose("Reading $dir/CVS/Root"); - my $root = ; - close(ROOT); - chomp $root; - $root =~ s/^.*://; - $line =~ s#^$root/## - or croak "Unable to determine toplevel CVS directory\n"; - } - chomp $line; - $line =~ s{[^/]+}{..}g; - $line =~ s{^\.\.}{.}; - $line =~ s{^\./}{}; - $self->{TOP} = $line; - - # Read CVS/Entries - open(ENTRIES, "< $dir/CVS/Entries") - or croak "Unable to read file $dir/CVS/Entries\n"; - $self->_verbose("Reading $dir/CVS/Entries"); - my @entries = ; - close(ENTRIES); - # Entries are sorted so that DIRS is also sorted. - foreach (sort @entries) { - chomp; - if (m|^D/([^/]+)/|) { - $entry = $dir."/".$1; - next if $self->_skippable($entry) or ! -d $entry; - push (@{$self->{DIRS}}, $entry); - push (@heredir, $entry); - $self->_verbose("Found directory: $entry"); - } elsif (m|^/([^/]+)/([^/]+)/([^/]+)/([^/]*)/(?:T[^/]+)?$|) { - $entry = $dir."/".$1; - next if $self->_skippable($entry) or ! -f $entry; - $self->{FILES}->{$entry} = { - REV => $2, - DATE => $3, - KEYWORD => $4, - }; - $self->_verbose("Found file $entry, rev. $2, date $3"); - } elsif (m|^D$|) { - # Hmmm, what is this entry for? - } else { - carp "Unable to parse line:\n\t$_\n"; - } - } - return unless $self->{OPTIONS}->{recursive}; - foreach my $d (@heredir) { - next if $self->_skippable($d); - $self->readinfo($d, %options); - } -} - -# Set $self->{SKIP} according to $self->{OPTIONS}->{skipdir} and -# $self->{OPTIONS}->{matchfile} -sub _fix_skip { - my $self = shift; - if (ref($self->{OPTIONS}) eq "HASH") { - my $sub = "\$_ = shift; if (-d \$_) { return 1 if m{^(.*/)?CVS\$};"; - ref($self->{OPTIONS}->{skipdir}) eq "ARRAY" and do { - foreach (@{$self->{OPTIONS}->{skipdir}}) { - $sub .= "return 1 if m{/$_\$};"; - } - }; - $sub .= "return 0; }"; - ref($self->{OPTIONS}->{matchfile}) eq "ARRAY" and do { - foreach (@{$self->{OPTIONS}->{matchfile}}) { - $sub .= "return 0 if m{$_};"; - } - }; - $sub .= "return 1"; - $self->{SKIP} = eval "sub {$sub}"; - } else { - $self->{SKIP} = sub {}; - } -} - -sub _skippable { - my $self = shift; - return 0 unless &{$self->{SKIP}}($_[0]); - $self->_verbose("Skipping $_[0]"); - return 1; -} - -=item reset - -Clear all data set by previous call to C. - - $cvs->readinfo("src"); - $cvs->reset(); - $cvs->readinfo("doc"); - -=cut - -sub reset { - my $self = shift; - $self->{DIRS} = []; - $self->{FILES} = {}; -} - -=item topdir - -Return relative path of the top directory CVS checked out copy. -This path is the one when C was called. - - my $root = $cvs->topdir(); - -=cut - -sub topdir { - my $self = shift; - return $self->{TOP}; -} - -=item removefile - -Remove an entry from the file list. - - $cvs->removefile("src/main.c"); - -=cut - -sub removefile { - my $self = shift; - delete $self->{FILES}->{$_[0]}; -} - -=item dirs - -Return a reference to the list of directories contained in current -working directory. - - foreach (@{$cvs->dirs()}) { - print "Found directory: $_\n"; - } - -=cut - -sub dirs { - my $self = shift; - return $self->{DIRS}; -} - -=item files - -Return a reference to file list. - - foreach (@{$cvs->files()}) { - print "Found file: $_\n"; - } - -=cut - -sub files { - my $self = shift; - return [keys %{$self->{FILES}}]; -} - -=item revision - -First argument is a filename. If there is no more argument, the CVS -revision of this file is returned, otherwise it is set to the 2nd -argument. - - my $rev = $cvs->revision("src/foo.c"); - -=cut - -sub revision { - my $self = shift; - my $file = shift; - return undef if !defined($self->{FILES}->{$file}); - $self->{FILES}->{$file}->{REV} = $_[0] if @_; - return $self->{FILES}->{$file}->{REV}; -} - -=item date - -First argument is a filename. If there is no more argument, the latest -commit date of this file is returned (in a format similar to the -C command output), otherwise it is set to the 2nd argument. - - my $date = $cvs->date("src/foo.c"); - -=cut - -sub date { - my $self = shift; - my $file = shift; - return undef if !defined($self->{FILES}->{$file}); - $self->{FILES}->{$file}->{DATE} = $_[0] if @_; - return $self->{FILES}->{$file}->{DATE}; -} - -=item keyword - -First argument is a filename. If there is no more argument, the keyword -substitution method (see the B<-k> flag of the C command) for this -file is returned, otherwise it is set to the 2nd argument. - - my $kflag = $cvs->keyword("src/foo.c"); - -=cut - -sub keyword { - my $self = shift; - my $file = shift; - return undef if !defined($self->{FILES}->{$file}); - $self->{FILES}->{$file}->{KEYWORD} = $_[0] if @_; - return $self->{FILES}->{$file}->{KEYWORD}; -} - -=back - -=head1 AUTHOR - -Copyright (C) 2001 Denis Barbier - -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -=cut - -1; - diff --git a/Perl/Local/VCS_CVS.pm b/Perl/Local/VCS_CVS.pm deleted file mode 100644 index 1f140742d47..00000000000 --- a/Perl/Local/VCS_CVS.pm +++ /dev/null @@ -1,679 +0,0 @@ -#!/usr/bin/perl - -## Copyright (C) 2008 Bas Zoetekouw -## -## This program is free software; you can redistribute it and/or modify it -## under the terms of version 2 of the GNU General Public License as published -## by the Free Software Foundation. - -=head1 NAME - -Local::VCS_CVS - generic wrapper around version control systems -- CVS version - -=head1 SYNOPSIS - - use Local::VCS_CVS; - use Data::Dumper; - - my $VCS = Local::VCS->new(); - my %info = $VCS->path_info( '.', recursive => 1, verbose => 1 ); - print Dumper($info{'foo.wml'}); - - my %info2 = svn_file_info( 'foo.wml' ); - print Dumper(\%info2); - -=head1 DESCRIPTION - -This module retrieves CVS info (such as revision of latest change, date -of latest change, author, etc) for checked-out object in a working directory. - -=head1 METHODS - -=over 4 - -=cut - -package Local::VCS_CVS; - -use 5.008; - -use Local::Cvsinfo; -use File::Basename; -use File::Spec::Functions qw( rel2abs splitdir catfile rootdir catdir ); -use File::stat; -use Carp; -use Fcntl qw/ SEEK_SET /; -use Data::Dumper; -use Date::Parse; -use POSIX qw/ WIFEXITED /; - -use strict; -use warnings; - -BEGIN { - use base qw( Exporter ); - - our $VERSION = "1.14"; - our @EXPORT_OK = qw( - &new - ); - our %EXPORT_TAGS = ( 'all' => [@EXPORT_OK] ); -} - - -=item new - -This is the constructor. - - my $VCS = Local::VCS->new(); - -=cut - -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $self = { - CACHE => {}, - }; - bless ($self, $class); - return $self; -} - -sub cache_file { - my $self = shift; - my $file = shift; - - if ($self->{CACHE}{"$file"}) { - print "$file is already cached...\n"; - return; - } - print "Adding $file to cache\n"; - $self->{CACHE}{"$file"} = 1; - return; -} - -sub cache_repo { - my $self = shift; - # Does nothing here... -} - -# handling debugging -my $DEBUG = 0; -sub _debug -{ - my @text = @_; - return unless $DEBUG; - print STDERR "=> ", @text, "\n"; - return; -} - -# return the type of the specified file -sub _typeoffile; - - -=item cmp_rev - -Compare two revision strings for a given file - -Takes the file path and two revision strings as arguments, and -returns 1 if the first one is newer, --1 if the second one is newer, -0 if they are equal -=cut -sub cmp_rev -{ - my $self = shift; - my $file = shift || ""; # unused here - my $a = shift || '0'; - my $b = shift || '0'; - - my @a = split( /\./, $a ); - my @b = split( /\./, $b ); - - # compare the two revision string term by term - my $i = 0; - while (1) - { - # first check if there are terms left in both revisions - if ( $i > $#a and $i>$#b ) { return 0 }; - if ( $i > $#a ) { return -1 }; - if ( $i > $#b ) { return 1 }; - - # then check this term - if ( $a[$i] < $b[$i] ) { return -1; } - if ( $a[$i] > $b[$i] ) { return 1; } - - # terms are equal, look at the next one - - $i++; - } - - # should never be reached - croak "Internal error: this should never be executed"; -} - -=item count_changes - -Return the number of changes to particular file between two revisions - -The first argument is a name of a file. -The second and third argument specify the revision range - -Example use: - - my $num1 = svn_count_changes( 'foo.c', 'r42', 'r70' ); - my $num2 = svn_count_changes( 'foo.c', 'r42', 'HEAD' ); - -=cut - -sub count_changes -{ - my $self = shift; - my $file = shift or return undef; - my $rev1 = shift || '1.1'; - my $rev2 = shift || 'HEAD'; - - $rev1 = '1.1' if $rev1 eq 'n/a'; - - # find the version number of HEAD, if it was specified - if ( $rev2 eq 'HEAD' ) - { - my %info = $self->file_info( $file ); - return -1 if not %info; - $rev2 = $info{'cmt_rev'}; - } - - # for CVS, this is pretty easy: we simply compare the two version numbers - # note: we don't support branches (aren't used in the webwml repo anyway) - my @rev1 = split( /\./, $rev1 ); - my @rev2 = split( /\./, $rev2 ); - - croak "non-similar revision numbers `$rev1' and `$rev2' (different branches?)" - if ( scalar @rev1 != scalar @rev2 ); - - # check that all but the last components of the version numbers match - # i.e., we can compare 2.0.1 and 2.0.17, but not 1.0.2 and 2.0.17 - while ( @rev1 > 1 ) - { - croak "non-similar revision numbers (different branches?)" - unless shift @rev1 == shift @rev2; - } - - return $rev2[0] - $rev1[0]; -} - - -=item path_info - -Return CVS information and status about a tree of files. - -The first argument is a name of a file or directory, and subsequent arguments -form a hash of named options (see below). - -The function returns a hash, which for each filename contains -Subversion status information: - - 'type' => type of the file ('d' directory, 'f' regular file, etc) - 'cmt_rev' => revision in which latest change was made to this file - 'cmt_date' => date on which latest change to this file was committed - -Optional remaining arguments are a hash array with options: - - recursive: if set to a true value (and the specified file is a directory), - recurse into subdirectories - match_pat: only files/dirs that match this pattern are processed - skip_pat: files/dirs that match this pattern are skipped - -Example uses: - - my %info1 = $path_info( 'src' ); - my %info2 = $readinfo( 'src', recursive => 1 ); - my %info3 = $readinfo( 'src', recursive => 1, match_pat => '\.c$' ); - -=cut - -# todo: verbose - -sub path_info -{ - my $self = shift; - my ($dir,%options) = @_; - - croak("No file or directory specified") unless $dir; - _debug "Called with $dir"; - - my $recurse = $options{recursive} || $options{recurse} || 0; - my $match_pat = $options{match_pat} || undef; - my $skip_pat = $options{skip_pat} || undef; - - _debug "Recurse is $recurse"; - _debug "Match pattern is '$match_pat'" if defined $match_pat; - _debug "Skip pattern is '$skip_pat'" if defined $skip_pat; - - # $cvs->readinfo expects a matchfile input; if nothing is specified, we - # pass a pattern that matches everything - $match_pat ||= '.'; - - $dir = rel2abs( $dir ); - - # use Local::Cvsinfo to do the actual work in CVS - my $cvs = Local::Cvsinfo->new(); - $cvs->readinfo( $dir, recursive => $recurse, matchfile => [$match_pat] ); - my $files = $cvs->files; - - # construct a nice hash from the data we received from Cvsinfo - my %data; - for my $file (keys %{$cvs->{FILES}}) - { - # we return relative paths, so strip off the dir name - my $file_rel = $file; - $file_rel =~ s{^$dir/?}{}; - - # skip files that match the skip pattern - next if $skip_pat and $file_rel =~ m{$skip_pat}; - - $data{$file_rel} = { - 'cmt_rev' => $cvs->{FILES}->{$file}->{'REV'}, - 'cmt_date' => str2time( $cvs->{FILES}->{$file}->{'DATE'} ), - 'type' => _typeoffile $file, - }; - } - - return %data; -} - -=item file_info - -Return VCS information and status about a single file - -The single argument is a name of a file. - -The function returns a hash, which contains VCS status information for -the specified file: - - 'type' => type of the file ('d' directory, 'f' regular file, etc) - 'cmt_rev' => revision in which latest change was made to this file - 'cmt_date' => date on which latest change to this file was committed - -Example use: - - my %info = $file_info( 'foo.wml' ); - -=cut - -sub file_info -{ - my $self = shift; - my $file = shift or carp("No file specified"); - my %options = @_; - - my $quiet = $options{quiet} || undef; - - my ($basename,$dirname) = fileparse( rel2abs $file ); - - # note: for some weird reason, the file is returned as '.' - my %info = $self->path_info( $dirname, 'recursive' => 0 ); - - if ( not ( exists $info{$basename} and $info{$basename} ) ) - { - carp("No info found about `$file' (does the file exist?)") if ( ! $quiet ); - return; - } - - return %{ $info{$basename} }; -} - -=item get_log - -Return the log info about a specified file - -The first argument is a name of a checked-out file. -The (optional) second and third argument specify the starting and end revision -of the log entries - -Example use: - - my @log_entries = get_log( 'foo.wml' ); - -=cut - -sub get_log -{ - my $self = shift; - my $file = shift or return; - my $rev1 = shift || '0'; - my $rev2 = shift || ''; - - my @logdata; - - # set the record separator for cvs log output - local $/ = "\n----------------------------\n"; - - my $command = sprintf( 'cvs log -r%s:%s %s', $rev1, $rev2, $file ); - open( my $cvs, '-|', $command ) - or croak("Couldn't run `$command': $!"); - - # skip the first record (gives genral meta-info) - <$cvs>; - - # read the consequetive records - while ( my $record = <$cvs> ) - { - #print "==> $record\n"; - - # the first two lines of a record contains metadata that looks like this: - # revision 1.4 - # date: 2008-09-18 16:21:31 +0200; author: bas; state: Exp; lines: +212 -105; commitid: aGcNZ0HjJeSEfgjt; - - # first split off the first line - my ($metadata1,$metadata2,$logmessage) = split( /\n/, $record, 3 ); - - my ($revision) = $metadata1 =~ m{^revision (.+)}; - my ($date,$author) = $metadata2 =~ m{^date: (.*?); author: (.*?); state: }; - - croak( "Couldn't parse output of `$command'" ) - unless $revision and $date and $author; - - # convert date to unixtime - $date = str2time( $date ); - - # last line of the log message is still the record separator - $logmessage =~ s{\n[^\n]+\n$}{}ms; - - push @logdata, { - 'rev' => $revision, - 'date' => $date, - 'author' => $author, - 'message' => $logmessage, - }; - } - close( $cvs ); - - return reverse @logdata; -} - -=item get_diff - -Returns a hash of (filename,diff) pairs containing the unified diff between two version of a (number of) files. - -The first argument is a name of a checked-out file. The second and third -argument specify the starting and end revision of the log entries. If the -third argument is not specified, the current (possibly modified) version is -used. If the second argument is also not specified, the current (possibly -modified) version is diffed against the latest checked in version. - -Example use: - - my %diffs = get_diff( 'foo.wml', '1.4', '1.17' ); - my %diffs = get_diff( 'bla.wml', '1.8' ); - my %diffs = get_diff( 'bas.wml' ); - -=cut - -sub get_diff -{ - my $self = shift; - my $file = shift or return; - my $rev1 = shift; - my $rev2 = shift; - - # hash to store the output - my %data; - - my $command = sprintf( 'cvs -q diff %s %s -u %s 2> /dev/null', - defined $rev1 ? "-r$rev1" : '', - defined $rev2 ? "-r$rev2" : '', - $file ); - - # set the record separator for cvs diff output - local $/ = "\n" . ('=' x 67) . "\n"; - -# print "$command\n"; - open( my $cvs, '-|', $command ) - or croak("Couldn't run `$command': $!"); - - # the first "record" is bogusl - <$cvs>; - - # read the consequetive records - while ( my $record = <$cvs> ) - { - # remove the record separator from the end of the record - $record =~ s{ $/ \n? \Z }{}msx; - - # remove the "Index:" line from the end of the record -# $record =~ s{ ^Index: [^\n]+ \n+ \Z }{}msx; - - # remove the first three lines - $record =~ s{ \A (?: .*? \n ){3} }{}msx; - -# # get the file name -# if ( not $record =~ m{ \A --- \s+ ([^\t]+) \t }msx ) -# { -# croak("Parse error in output of `$command'"); -# } -# my $file = $1; - - $data{$file} = $record; - } - close( $cvs ); - - return %data; -} - - -# returns the respository -sub _get_repository -{ - open( my $fd, '<', 'CVS/Repository' ) - or croak("Couldn't open `CVS/Repository': $!"); - my $repo = <$fd>; - close( $fd ); - - chomp $repo; - return $repo; -} - -=item get_file - -Return a particular revision of a file - -The first argument is a name of a file. -The second argument is the revision. - -This function retrieves the specified revision fo the file from the repository -and returns it (without writing anything in the current checked-out tree) - -Example use: - - my $text = get_file( 'foo.c', '1.12' ); - -=cut - -sub get_file -{ - my $self = shift; - my $file = shift or croak("No file specified"); - my $rev = shift or croak("No revision specified"); - - croak( "No such file: $file" ) unless -f $file; - - #TODO: what happens if we're not in the root webwml dir? - - my $command = sprintf( 'cvs -q checkout -p -r%s %s/%s', - $rev, _get_repository, $file ); - - - local $/ = ('=' x 67) . "\n"; - - my $text; - open ( my $cvs, '-|', $command ) - or croak("Error while executing `$command': $!"); - while ( my $line = <$cvs> ) - { - $text .= $line; - } - close( $cvs ); - croak("Error while executing `$command': $!") unless WIFEXITED($?); - - # return the file - return $text; -} - -=item get_oldest_revision - -Return the version of the oldest version of a file - -The first argument is a name of a file. - -This function finds the oldest revision of a file that is known in the -repository and returns it. - -Example use: - - my $rev = get_oldest_revision( 'foo.c'); - -=cut - -sub get_oldest_revision -{ - my $self = shift; - my $file = shift or croak("No file specified"); - - croak( "No such file: $file" ) unless -f $file; - - return '1.1'; # earliest possible revision of any file, easy! -} - -=item get_newest_revision - -Return the version of the newest version of a file - -The first argument is a name of a file. - -This function finds the newest revision of a file that is known in the -repository and returns it. - -Example use: - - my $rev = get_newest_revision( 'foo.c'); - -=cut - -sub get_newest_revision -{ - # NOT SUPPORTED in the CVS code - - croak("NOT SUPPORTED IN THE CVS CODE"); -} - -=item next_revision - -Given a file path and a current revision of that file, move backwards -or forwards through the commit history and return a related revision. - -Takes three arguments: the file path, the start revision and an -integer to specify which direction to move *and* how far. A negative -number specifies backwards in history, a positive number specifies -forwards. - -Example use: - - my $rev = next_revision( 'foo.c', '72f6700577c79e6d284fbeac44366f6aa357d56d', -1); - -Returns the requested revision if it exists, otherwise *undef* - -=cut -sub next_revision -{ - # For the file we're looking at, we can easily generate an - # array (list) of all the commit hashes. Then we can see where - # in that list the specified revision lies. - # - # FIXME: Only deals with simple moves backwards/forwards along the trunk - - my $self = shift; - my $file = shift or return undef; - my $rev1 = shift or return undef; - my $move = shift or return undef; - - my $newrev = $rev1; - $newrev =~ s/(\d+)$/($1 + $move)/e; - return $newrev; -} - -=item get_topdir - -Return the top dir of the webwml repository - -The first argument is a name of a checked-out file or directory. -If it is not specified, by default the current directory is used. - -Example use: - - my $dir = get_topdir( 'foo.c' ); - -=cut - -sub get_topdir -{ - my $self = shift; - my $file = shift || '.'; - - my $cvs = Local::Cvsinfo->new(); - $cvs->readinfo( $file ); - my $root = $cvs->topdir() - or croak ("Unable to determine top-level directory"); - - # TODO: add some check that this really is the top level dir - - return $root; -} - - - - - -###################################### -## internal functions -###################################### - - -# return the type of the input argument (file, dir, symlink, etc) -sub _typeoffile -{ - my $file = shift or return; - - stat $file or croak("Couldn't stat file `$file'"); - - return 'f' if ( -f _ ); - return 'd' if ( -d _ ); - return 'l' if ( -l _ ); - return 'S' if ( -S _ ); - return 'p' if ( -p _ ); - return 'b' if ( -b _ ); - return 'c' if ( -c _ ); - - return ''; -} - - -=back - -=head1 AUTHOR - -Copyright (C) 2008 Bas Zoetekouw - -This program is free software; you can redistribute it and/or modify it under -the terms of version2 of the GNU General Public License as published by the -Free Software Foundation. - -=cut - -42; - - -# stuff below is an old Subversion implementation that we probably won't use -# ignore for now, I will get rid of it as the rewrite progresses -# -- Bas. -__END__ -- cgit v1.2.3