summaryrefslogtreecommitdiff
path: root/solenv/bin/modules/Cvs.pm
diff options
context:
space:
mode:
Diffstat (limited to 'solenv/bin/modules/Cvs.pm')
-rw-r--r--solenv/bin/modules/Cvs.pm576
1 files changed, 0 insertions, 576 deletions
diff --git a/solenv/bin/modules/Cvs.pm b/solenv/bin/modules/Cvs.pm
deleted file mode 100644
index 6eb445be2031..000000000000
--- a/solenv/bin/modules/Cvs.pm
+++ /dev/null
@@ -1,576 +0,0 @@
-#*************************************************************************
-#
-# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
-#
-# Copyright 2008 by Sun Microsystems, Inc.
-#
-# OpenOffice.org - a multi-platform office productivity suite
-#
-# $RCSfile: Cvs.pm,v $
-#
-# $Revision: 1.26 $
-#
-# This file is part of OpenOffice.org.
-#
-# OpenOffice.org is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License version 3
-# only, as published by the Free Software Foundation.
-#
-# OpenOffice.org is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU Lesser General Public License version 3 for more details
-# (a copy is included in the LICENSE file that accompanied this code).
-#
-# You should have received a copy of the GNU Lesser General Public License
-# version 3 along with OpenOffice.org. If not, see
-# <http://www.openoffice.org/license.html>
-# for a copy of the LGPLv3 License.
-#
-#*************************************************************************
-
-#
-# Cvs.pm - package for manipulating CVS archives
-#
-
-package Cvs;
-use strict;
-
-use Carp;
-use CwsConfig;
-
-##### constructor ####
-
-sub new
-{
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $self = {};
- $self->{NAME} = undef;
- $self->{HEAD} = undef;
- $self->{FLAGS} = undef;
- my $conf = CwsConfig::get_config();
- if ( $conf->cvs_binary() ) {
- $self->{CVS_BINARY} = $conf->cvs_binary();
- }
- else {
- if ($^O eq "MSWin32" ) {
- $self->{CVS_BINARY} = "cvsclt2.exe";
- }
- else {
- $self->{CVS_BINARY} = "cvs.clt2";
- }
- }
- $self->{ARCHIVE_PATH} = undef;
- $self->{REPOSITORY_REV} = undef;
- $self->{REV_DATA} = {};
- $self->{REV_SORTED} = [];
- $self->{REV_TAGS} = {};
- $self->{TAGS} = {};
- $self->{"_PARSED"} = undef;
- $self->{"_SORTED"} = undef;
- $self->{"_TAGGED"} = undef;
- bless ($self, $class);
- return $self;
-}
-
-#### methods to access per object data ####
-
-sub name
-{
- my $self = shift;
- if ( @_ ) {
- $self->{NAME} = shift;
- }
- return $self->{NAME};
-}
-
-sub cvs_binary
-{
- my $self = shift;
- if ( @_ ) {
- $self->{CVS_BINARY} = shift;
- }
- return $self->{CVS_BINARY};
-}
-
-sub get_data_by_rev
-{
- my $self = shift;
- $self->parse_log();
-
- return $self->{REV_DATA};
-}
-
-sub get_sorted_revs
-{
- my $self = shift;
-
- if ( $self->{"_SORTED"} ) {
- return $self->{REV_SORTED};
- }
-
- $self->parse_log();
-
- sub by_rev {
- # comparison function for sorting
- my (@field_a, @field_b, $min_field, $i);
-
- @field_a = split /\./, $a;
- @field_b = split /\./, $b;
- $min_field = ($#field_a > $#field_b) ? $#field_b : $#field_a;
-
- for ($i = 0; $i <= $min_field; $i++) {
- if ( ($field_a[$i] < $field_b[$i]) ) {
- return -1;
- }
- if ( ($field_a[$i] > $field_b[$i]) ) {
- return 1;
- }
- }
-
- if ( $#field_a == $#field_b ) {
- return 0;
- }
- # eg. 1.70 sorts before 1.70.1.0
- ($#field_a < $#field_b) ? return -1 : return 1;
- }
-
- @{$self->{REV_SORTED}} = sort by_rev (keys %{$self->{REV_DATA}});
- $self->{"_SORTED"} = 1;
- return $self->{REV_SORTED};
-}
-
-sub get_tags_by_rev
-{
- my $self = shift;
- my ($tag, $rev);
-
- if ( $self->{"_TAGGED"} ) {
- return $self->{REV_TAGS};
- }
-
- $self->parse_log();
- foreach $tag (keys %{$self->{TAGS}}) {
- $rev = $self->{TAGS}->{$tag};
- push (@{$self->{REV_TAGS}->{$rev}}, $tag);
- }
-
- $self->{"_TAGGED"} = 1;
- return $self->{REV_TAGS};
-}
-
-sub get_flags
-{
- my $self = shift;
- $self->parse_log();
-
- return $self->{FLAGS};
-}
-
-sub get_tags
-{
- my $self = shift;
-
- $self->parse_log();
- return $self->{TAGS};
-}
-
-sub get_head
-{
- my $self = shift;
-
- $self->parse_log();
- return $self->{HEAD};
-}
-
-sub get_repository_rev
-{
- my $self = shift;
-
- if( !$self->{REPOSITORY_REV} ) {
- # ignore return values
- $self->status();
- }
- return $self->{REPOSITORY_REV};
-}
-
-sub get_archive_path
-{
- my $self = shift;
-
- if( !$self->{ARCHIVE_PATH} ) {
- # ignore return values
- $self->status();
- }
- return $self->{ARCHIVE_PATH};
-}
-
-sub is_tag
-{
- my $self = shift;
- my $tag = shift;
-
- my $tags_ref = $self->get_tags();
- return (defined $$tags_ref{$tag}) ? 1 : 0;
-}
-
-# Check if $label is branch label and returns revision.
-sub get_branch_rev
-{
- my $self = shift;
- my $label = shift;
-
- return 0 if $label eq '';
- my $tags_ref = $self->get_tags();
- my $rev = $$tags_ref{$label};
- return 0 if !defined($rev);
- my @field = split('\.', $rev);
- # $label is a branch label if rev is of form (...)x.y.0.z
- return 0 if $field[-2] != 0;
- $field[-2] = $field[-1];
- # remove last
- pop @field;
- return join('.', @field);
-}
-
-sub get_latest_rev_on_branch
-{
- my $self = shift;
- my $label = shift;
-
- my $branch_rev = $self->get_branch_rev($label);
- return 0 if !$branch_rev;
-
- my $latest_rev_on_branch = 0;
-
- foreach ( @{$self->get_sorted_revs()} ) {
- if ( $_ =~ /^$branch_rev\.(\d+)$/ ) {
- $latest_rev_on_branch = $_;
- }
- }
-
- # No revision has ever been commited on this branch,
- # return branch root.
- if ( !$latest_rev_on_branch ) {
- $branch_rev =~ /^(.*)\.(\d+)$/;
- $latest_rev_on_branch = $1;
- }
- return $latest_rev_on_branch;
-}
-
-
-#### methods to manipulate archive ####
-
-# Delete a revision. Use with care.
-sub delete_rev
-{
- my $self = shift;
- my $rev = shift;
- my $file = $self->name();
-
- my $response_ref = $self->execute("admin -o$rev $file");
- foreach ( @{$response_ref} ) {
- /deleting revision $rev/ && return 1;
- }
- return 0;
-}
-
-# Update archive with options $options. Returns 'success' and new revision
-# on success or reason of failure. If no update happens because file was
-# up-to-date consider operation a success.
-sub update
-{
- my $self = shift;
- my $options = shift;
-
- my $file = $self->name();
- my $response_ref = $self->execute("update $options $file");
- my $conflict = 0;
- my $notknown = 0;
- my $connectionfailure = 0;
- foreach ( @{$response_ref} ) {
- /conflicts during merge/ && ++$conflict;
- /nothing known about/ && ++$notknown;
- /\[update aborted\]: connect to/ && ++$connectionfailure;
- }
- if ( $conflict || $notknown || $connectionfailure) {
- my $failure = 'unknownfailure';
- $failure = 'conflict' if $conflict;
- $failure = 'notknown' if $notknown;
- $failure = 'connectionfailure' if $connectionfailure;
- return $failure;
- }
- return 'success';
-}
-
-# Commit $file with option $option; return 'success' or reason for failure.
-# If 'success' return the new revision as second element.
-sub commit
-{
- my $self = shift;
- my $options = shift;
-
- my $file = $self->name();
- my $response_ref = $self->execute("commit $options $file");
-
- # already commited ?
- return 'nothingcommitted' if !@{$response_ref};
-
- my $conflict = 0;
- my $uptodate = 0;
- my $notknown = 0;
- my $success = 0;
- my $connectionfailure = 0;
- my $new_revision = undef;
- foreach ( @{$response_ref} ) {
- /Up-to-date check failed/ && ++$uptodate;
- /nothing known about/ && ++$notknown;
- /had a conflict and has not been modified/ && ++$conflict;
- /new revision: (delete);/ && (++$success, $new_revision = $1);
- /new revision: ([\d\.]+);/ && (++$success, $new_revision = $1);
- /\[commit aborted\]: connect to/ && ++$connectionfailure;
- }
- if ( !$success ) {
- my $failure = 'unknownfailure';
- $failure = 'conflict' if $conflict;
- $failure = 'notuptodate' if $uptodate;
- $failure = 'notknown' if $notknown;
- $failure = 'connectionfailure' if $connectionfailure;
- return $failure;
- }
- return wantarray ? ('success', $new_revision) : 'success';
-}
-
-# Tag file with specified tag. Options may be specified,
-# '-b' for a branch tag and -F for forced tag are valid options.
-# '-B' to force moving existing tag also is valid.
-# Retagging without moving the tag is considered a succesful
-# operation.
-sub tag
-{
- my $self = shift;
- my $tag = shift;
- my $options = shift;
-
- return 'invalidtag' if !$tag;
- # check for valid options
- if ( $options ) {
- my @elem = split(' ', $options);
- foreach (@elem) {
- unless ( /-B/ || /^-F/ || /-b/ ) {
- return 'invalidoption';
- }
- $options = join(' ', @elem);
- }
- }
- else {
- $options = '';
- }
-
- my $file = $self->name();
- my $response_ref = $self->execute("tag $options $tag $file");
-
- unless ( $options =~ /-F/ && $options =~ /-b/ ) {
- # No message from CVS means that tag already exists
- # and has not been moved.
- # If both -F and -b is given, CVS will always return
- # message.
- return 'success' if !@{$response_ref};
- }
-
- my $tagged = 0;
- my $cant_move = 0;
- my $connectionfailure = 0;
- my $invalidfile = 0;
- foreach ( @{$response_ref} ) {
- /^T \Q$file\E/ && ++$tagged;
- /NOT MOVING tag/ && ++$cant_move;
- /nothing known about/ && ++$invalidfile;
- /\[tag aborted\]: connect to/ && ++$connectionfailure;
- }
- return 'success' if $tagged;
- return 'cantmove' if $cant_move;
- return 'connectionfailure' if $connectionfailure;
- return 'invalidfile' if $invalidfile;
- # should never happen
- return 'unknownfailure';
-}
-
-#### misc operations ####
-
-# Return status information. Note that this is somewhat redundant with
-# the information which can be retrieved from the log, but in some cases
-# we can avoid the more expansive parsing of the log by calling this method.
-# We don't save the status information between calls.
-sub status
-{
- my $self = shift;
-
- my $file = $self->name();
- my ($nofile, $unknownfailure, $connectionfailure);
- my ($status, $working_rev);
- my ($sticky_tag, $branch, $sticky_date, $sticky_options);
-
- my $response_ref = $self->execute("status $file");
- foreach ( @{$response_ref} ) {
- chomp();
- /File: no file/ && ++$nofile;
- /Status:\s+([\w\-\s]+)$/ && ($status = $1);
- /Working revision:\s+((\d|\.)+)/ && ($working_rev = $1);
- /Repository revision:\s+((\d|\.)+)\s+(\S+)/ && ($self->{REPOSITORY_REV} = $1) && ($self->{ARCHIVE_PATH} = $3);
- /Sticky Tag:\s+(.+)/ && ($sticky_tag = $1);
- /Sticky Date:\s+(.+)/ && ($sticky_date = $1);
- /Sticky Options:\s+(.+)/ && ($sticky_options = $1);
- /\[status aborted\]: connect to/ && ++$connectionfailure;
- }
-
- return 'connectionfailure' if $connectionfailure;
- # all variables except $status will contain garbage if 'Locally Added'
- # or 'Unknown'
- return $status if ($status eq 'Locally Added' || $status eq 'Unknown');
- # same if $nofile is set
- return $status if $nofile;
-
- if ( $sticky_tag =~ /([\w\-]+) \(branch: ([\d\.]+)\)$/ ) {
- $sticky_tag = $1;
- $branch = $2;
- }
-
- $sticky_date = '' if $sticky_date eq '(none)';
- $sticky_options = '' if $sticky_options eq '(none)';
-
- if ( $sticky_options =~ /\-(\w+)/ ) {
- $sticky_options = $1;
- }
-
- $unknownfailure++ if !$status;
-
- return 'unknownerror' if $unknownfailure;
- return ($status, $working_rev, $self->{REPOSITORY_REV}, $sticky_tag, $branch,
- $sticky_date, $sticky_options);
-}
-
-# Return a diff between two revision of an archive.
-sub diff
-{
- my $self = shift;
- my $rev1 = shift;
- my $rev2 = shift;
- my $options = shift || '';
-
- my $file = $self->name();
- my ($nofile, $unknowntagfailure, $unknownrevfailure, $connectionfailure);
-
- my $response_ref = $self->execute("diff $options -r$rev1 -r$rev2 $file");
-
- foreach ( @{$response_ref} ){
- /\[diff aborted\]: connect to/ && ++$connectionfailure;
- /cvs \[server aborted\]: no such tag \w+/ && ++$unknowntagfailure;
- /cvs server: tag [\d\.]+ is not in file $file/ && ++$unknownrevfailure;
- }
-
- return 'connectionfailure' if $connectionfailure;
- return 'unknowntagfailure' if $unknowntagfailure;
- return 'unknownrevfailure' if $unknownrevfailure;
- return wantarray ? @{$response_ref} : $response_ref;
-}
-#### private methods ####
-
-sub execute
-{
- my $self = shift;
- my $command = shift;
- my $authtimeout = 0;
- my @response;
- while () {
- if ( $authtimeout >= 5 ) {
- # fail after 5 tries
- die("FATAL: OOo CVS server authorization time out, can't continue!\nPlease notify Release Engineering.")
- }
- if ( $authtimeout > 0 ) {
- # sleep 5 seconds after a authorization timeout
- carp("WARNING: OOo CVS server authorization time out, count: $authtimeout, sleeping for 5 seconds ...");
- sleep(5);
- }
- # cvs option "-f" for disabling the reading of $HOME/.cvsrc, if any
- open(CVS, "$self->{CVS_BINARY} -f $command 2>&1 |");
- @response = <CVS>;
- close(CVS);
-
- foreach ( @response ) {
- if ( /unrecognized auth response/ ) {
- # don't get fooled by comment of rev. 1.14
- /#i25646#: catch 'unrecognized auth response' from OOo CVS server/ && next;
- # ok, seems to be a real timeout
- ++$authtimeout;
- }
- }
- last if !$authtimeout;
- }
- return wantarray ? @response : \@response;
-}
-
-sub parse_log
-{
- my $self = shift;
- if ( $self->{"_PARSED"} ) {
- return;
- }
- my $file = $self->name();
- my $in_revisions = 0;
- my $in_tags = 0;
- my $rev_data = {};
- my ($rev, $date, $author, $state, $comment, @branches);
-
- my $response_ref = $self->execute("log $file");
-
- foreach ( @{$response_ref} ) {
- chomp;
-
- if ( $in_revisions ) {
- /revision\s((\d|\.)+)$/o && do { $rev = $1; next; };
- /^date:\s(\S+\s\S+);\s+author:\s(\S+);\s+state:\s(\S+);/
- && do { $date = $1; $author = $2; $state = $3; next; };
- /^branches:((\s+(\d|\.)+;)+)$/o && do {
- my $line;
- $line = $1;
- $line =~ s/\s//go;
- @branches = split(/;/, $line);
- next;
- };
-
- (/^----------------------------$/o || /^=============================================================================$/o) && do
- {
- $rev_data = {DATE => $date,
- AUTHOR => $author,
- STATE => $state,
- COMMENT => $comment,
- BRANCHES => [ @branches ]};
- $self->{REV_DATA}->{$rev} = $rev_data;
- $comment = undef;
- @branches = ();
- next;
- };
-
- $comment .= $_ . "\n" ;
- }
- elsif ( $in_tags ) {
- /^keyword\ssubstitution:\s/o && do { $self->{FLAGS} = $'; $in_tags--; next; };
- # tags may contain a hyphen
- /^\t([\w|\-]+):\s((\d|\.)+)$/o && do { $self->{TAGS}->{$1} = $2; next; };
- }
- else {
- /^----------------------------$/o && do { $in_revisions++; next; };
- /^symbolic\snames:$/o && do { $in_tags++; next; };
- /^head:\s((\d|\.)+)$/o && do { $self->{HEAD} = $1; next; };
- /^RCS file:\s((\d|\.)+)$/o && do { $self->{ARCHIVE_PATH} = $1; next; };
- }
- }
-
- $self->{"_PARSED"} = 1;
-}
-
-####
-
-1; # needed by "use" or "require"
generated by cgit (git 2.34.1) at 2025-02-07 08:01:29 +0000