Subversion Repositories DevTools

########################################################################

# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.

#

# Module name   : JatsSvnCore.pm

# Module type   : Jats Support Module

# Compiler(s)   : Perl

# Environment(s): jats

#

# Description   : JATS LowLevel Subversion Interface Functions

#

#                 Requires a subversion client to be present on the machine

#                 Does require at least SubVersion 1.5

#                 Uses features not available in 1.4

#

#                 The package currently implements a set of functions

#                 There are some intentional limitations:

#                   1) Non recursive

#                   2) Errors terminate operation

#

#                 This package contains experimental argument passing

#                 processes. Sometimes use a hash of arguments

#

#......................................................................#

require 5.008_002;

use strict;

use warnings;

use JatsEnv;

#

#   Global Variables

#   Configuration variables imported from environment

#   Must be 'our' to work with EnvImport

#

our $GBE_SVN_PATH;                      # Optional: SVN bin directory

our $GBE_SVN_USERNAME;                  # Optional: User name

our $GBE_SVN_PASSWORD;                  # Optional: User passwrd

our $USER;

package JatsSvnCore;

use JatsError;

use JatsSystem;

use IPC::Open3;

use File::Path;             # Instead of FileUtils

use File::Basename;

use Cwd;

# automatically export what we need into namespace of caller.

use Exporter();

our (@ISA, @EXPORT, %EXPORT_TAGS, @EXPORT_OK);

@ISA         = qw(Exporter);

@EXPORT      = qw(

                    SvnSession

                    SvnUserCmd

                    SvnComment

                );

@EXPORT_OK =  qw(

                    ProcessRevNo

                    %SVN_URLS

                    @SVN_URLS_LIST

                );

%EXPORT_TAGS = (All => [@EXPORT, @EXPORT_OK]);

#

#   Package Global

#

my  $svn;                               # Abs path to 'svn' utility

my  $stdmux;                            # Abs path to stdmux utlity

our %SVN_URLS;                          # Exported repository URLs

our @SVN_URLS_LIST;                     # Exported repository URLs scan order

#-------------------------------------------------------------------------------

# Function        : BEGIN

#

# Description     : Module Initialization

#                   Invoked by Perl as soon as possible

#                       Setup environment variables

#                       Calculate globals

#

# Inputs          : None

#

# Returns         : Nothing

#

sub BEGIN

{

    #

    #   Determine authentication information

    #   If not present then assume that the user is already athenticated

    #

    ::EnvImportOptional('USER');

    ::EnvImportOptional('GBE_SVN_USERNAME');

    ::EnvImportOptional('GBE_SVN_PASSWORD');

    #

    #   User can provide a path to the svn utility

    #   It will be used if its present

    #

    ::EnvImportOptional('GBE_SVN_PATH', '');

    #

    #   For some reason thats not clear these EnvVars must be used in this function

    #   for them to be available elsewhere.

    #

    #   No it doesn't make sence to me either

    #   Problem seen on Linx. Not investigated on others

    #

    Debug ("GBE_SVN_USERNAME", $::GBE_SVN_USERNAME);

    Debug ("GBE_SVN_PASSWORD", $::GBE_SVN_PASSWORD);

    Debug ("GBE_SVN_PATH", $::GBE_SVN_PATH);

    $stdmux = LocateProgInPath ( 'stdmux');

    $svn    = LocateProgInPath ( 'svn', '--All', '--Path=' . $::GBE_SVN_PATH );

    #

    #   Don't report errors in not finding svn and stdmux

    #   Need to allow the help system to work.

    #

    #

    #   Extract GBE_SVN_XXXX_URL information from the environment

    #       XXXX is the first element of the repository path and will

    #            be globally (VIX) unique

    #       The value will be the URL to access this named repository path

    #       It will normally include the repository path

    #       The saved URL will be terminated with a single '/' to simplify usage

    #

    foreach ( sort keys %ENV )

    {

        if ( m ~^GBE_SVN_URL_*(.*)~ )

        {

            my $url = $ENV{$_};

            my $key = $1;

            $url =~ s~/*$~/~;

            $SVN_URLS{$key} = $url;

            #

            #   Ensure that it is in valid format

            #   Four forms are supported, although not all should be used

            #

            if ( $url =~ m{^svn://[^/]+} ) {

                #

                #   Type is SVN server

                #   Protocol + server name

                #

            } elsif ( $url =~ m{^https{0,1}://.+} ) {

                #

                #   Type is HTTP server

                #   Protocol + server name + path on server

                #

            } elsif ( $url =~ m{^file:///+[A-Z]:/} ) {

                #

                #   Type is local Repo (file)

                #   Windows absolute pathname

                #   file:///I:/path/...

                #

            } elsif ( $url =~ m{^file:///+[^/]} ) {

                #

                #   Type is local Repo (file)

                #   Unix absolute pathname

                #   file:///path/...

                #

            } else {

                ReportError ("GBE_SVN_URL format not understood","$key: $url");

            }

        }

    }

    @SVN_URLS_LIST = reverse sort keys %SVN_URLS;

    ErrorDoExit();

#DebugDumpData("%SVN_URLS", \%SVN_URLS, \@SVN_URLS_LIST);

}

#-------------------------------------------------------------------------------

# Function        : SvnSession

#

# Description     : Create a new SvnSession

#                   Simply used to contain information about the operations

#

# Inputs          : Nothing

#

# Returns         : A blessed ref

#

sub SvnSession

{

    my $self = {};

    #

    #   Delayed error reporting

    #   Allows the the package to be used when SVN is not installed

    #   as long as we don't want to use any of the features

    #

    #   Think of 'help' when svn is not yet installed

    #

    Error ("The JATS stdmux utility cannot be found" ) unless ( $stdmux );

    Error ("The svn utility cannot be found", "Configured Path: $::GBE_SVN_PATH") unless ( $svn );

    #

    #   Documented instance variables

    #

    $self->{REVNO} = undef;         # Revision of last Repository operation

    $self->{ERROR_LIST} = [];       # Last SVN operation errors

    $self->{RESULT_LIST} = [];      # Last SVN operation results

    $self->{PRINTDATA} = 0;         # Global control of ProcessRevNo

    bless ($self, __PACKAGE__);

}

#-------------------------------------------------------------------------------

# Function        : SvnDelete

#

# Description     : Delete a directory within a repository

#                   Intended to be used to remove tags and branches

#

# Inputs          : $self       - Instance data

#                   A hash of named arguments

#                       target     - Path to remove

#                       comment    - User comment

#                       noerror    - Don't panic on failure

#

#

# Returns         : True - delete failed and 'noerror' was present

#

sub SvnDelete

{

    my $self = shift;

    my %opt = @_;

    Debug ("SvnDelete");

    Error ("Odd number of args to SvnDelete") unless ((@_ % 2) == 0);

    Error ("SvnDelete: No target specified" ) unless ( $opt{'target'} );

    my $error =  $opt{'noerror'} ? '' : "SvnDelete: Target not deleted";

    my $rv = SvnCmd ($self, 'delete'

                    , $opt{'target'}

                    , '-m', SvnComment( $opt{'comment'}, 'Deleted by SvnDelete' ),

                    , { 'credentials' => 1,

                        'error' => $error } );

    return $rv;

}

#-------------------------------------------------------------------------------

# Function        : SvnRename

#

# Description     : Rename something within a repository

#                   Intended to be used to rename tags and branches

#

#                   A few tricks

#                   - Rename is the same as a copy-delete

#                     but it doesn't work if the source is pegged

#                     so we just use a copy.

#                   - Need to ensure the target does not exist

#                     because if it does then we may create a subdir

#                     within it.

#

# Inputs          : $self           - Instance data

#                   A hash of named arguments

#                       old      - Location within the repository to copy from

#                       new      - Location within the repository to copy to

#                       comment  - Commit comment

#                       revision - ref to returned revision tag

#                       tag      - ref to URL of the Check In

#                       replace  - True: Delete existing tag if present

#

# Returns         : Revision of the copy

#

sub SvnRename

{

    my $self = shift;

    my %opt = @_;

    Debug ("SvnRename");

    Error ("Odd number of args to SvnRename") unless ((@_ % 2) == 0);

    #

    #   Insert defaults

    #

    my $old = $opt{old} || Error ("SvnRename: Source not specified" );

    my $new = $opt{new} || Error ("SvnRename: Target not specified" );

    #

    #   Validate the source

    #   Must do this in case the target-delete fails

    #

    SvnValidateTarget ( $self,

                        'cmd'    => 'SvnRename',

                        'target' => $old,

                        'require' => 1,

                        );

    #

    #   Validate the target

    #   Repo needs to be valid, but we may be able

    #   to delete the target if it does exist

    #

    SvnValidateTarget ( $self,

                        'target' => $new,

                        'delete' => $opt{replace},

                        );

    #

    #   The 'rename' command does not handle a pegged source

    #   Detect this and use a 'copy' command

    #   We don't need to delete the source - as its pegged.

    #

    my $cmd = ($old =~ m~@\d+$~) ? 'copy' : 'rename';

    SvnCmd ($self, $cmd

                    , $old

                    , $new

                    , '-m', SvnComment($opt{'comment'},'Renamed by SvnRename'),

                    , { 'credentials' => 1,

                        'process' => \&ProcessRevNo

                      , 'error' => "SvnRename: Target not renamed" } );

    CalcRmReference($self, $new );

    Message ("Tag is: " . $self->{RMREF} );

    return $self->{RMREF} ;

}

#-------------------------------------------------------------------------------

# Function        : SvnCopy

#

# Description     : Copy something within a repository

#                   Intended to be used to copy tags and branches

#

#                   A few tricks

#                   - Need to ensure the target does not exist

#                     because if it does then we may create a subdir

#                     within it.

#

# Inputs          : $self           - Instance data

#                   A hash of named arguments

#                       old         - Location within the repository to copy from

#                       new         - Location within the repository to copy to

#                       comment     - Commit comment

#                       revision    - ref to returned revision tag

#                       tag         - ref to URL of the Check In

#                       replace     - True: Delete existing tag if present

#                       cmd         - Error Prefix

#                       validated   - Locations already validated

#                       parents     - Create parents as required

#

# Returns         : Revision of the copy

#

sub SvnCopy

{

    my $self = shift;

    my %opt = @_;

    Debug ("SvnCopy");

    Error ("Odd number of args to SvnCopy") unless ((@_ % 2) == 0);

    #

    #   Insert defaults

    #

    my $cmd = $opt{'cmd'} || 'SvnCopy';

    my $old = $opt{old} || Error ("$cmd: Source not specified" );

    my $new = $opt{new} || Error ("$cmd: Target not specified" );

    #

    #   Validate the source

    #   Must do this in case the target-delete fails

    #

    SvnValidateTarget ( $self,

                        'cmd'    => $cmd,

                        'target' => $old,

                        'require' => 1,

                        );

    #

    #   Validate the target

    #   Repo needs to be valid, but we may be able

    #   to delete the target if it does exist

    #

    SvnValidateTarget ( $self,

                        'cmd'    => $cmd,

                        'target' => $new,

                        'delete' => $opt{replace},

                        );

    #

    #   Copy the URLs

    #

    SvnCmd ($self   , 'copy'

                    , $old

                    , $new

                    , '-m', SvnComment($opt{'comment'},"Copied by $cmd")

                    , $opt{parents} ? '--parents' : ''

                    , { 'credentials' => 1

                      , 'process' => \&ProcessRevNo

                      , 'error' => "$cmd: Source not copied" } );

    CalcRmReference($self, $new );

    Verbose ("Tag is: " . $self->{RMREF} );

    return $self->{RMREF} ;

}

#-------------------------------------------------------------------------------

# Function        : SvnValidateTarget

#

# Description     : Validate a target within the repository

#                   Optional allow the target to be deleted

#                   Mostly used internally

#

# Inputs          : $self           - Instance data

#                   A hash of named arguments

#                       target      - Location within the repository to test

#                       cmd         - Name of command to use in messages

#                       delete      - Delete if it exists

#                       require     - Target must exist

#                       available   - Target must NOT exist

#                       comment     - Deletion comment

#                       test        - Just test existance

#                       create      - Create if it doesn't exist

#

# Returns         : May not return

#                   2 : Exists and was created

#                   1 : Exists

#                   0 : Not exist (any more)

#

sub SvnValidateTarget

{

    my $self = shift;

    my %opt = @_;

    Debug ("SvnValidateTarget", $opt{target});

    Error ("Odd number of args to SvnValidateTarget") unless ((@_ % 2) == 0);

    #

    #   Validate options

    #

    Error ("SvnValidateTarget: No target specified") unless ( $opt{target} );

    $opt{cmd} = "SvnValidateTarget" unless ( $opt{cmd} );

    my $cmd = $opt{cmd};

    #

    #   Ensure that the target path does not exist

    #   Cannot allow a 'copy'/'rename' to copy into an existing path as

    #   Two problems:

    #       1) We end up copying the source into a subdir of

    #          target path, which is not what we want.

    #       2) Should use update to do that sort of a job

    #

    unless ( SvnTestPath ( $self, $cmd, $opt{target} ))

    {

        #

        #   Target does not exist

        #

        return 0 if ( $opt{'test'} || $opt{'available'} );

        #

        #   Create target if required

        #

        if ( $opt{create} )

        {

            $self->SvnCmd ('mkdir', $opt{target}

                           , '-m', $self->Path() . ': Created by ' . $cmd

                           , '--parents'

                           , { 'credentials' => 1

                              ,'error' => "SvnCreateBranch"

                              ,'process' => \&ProcessRevNo

                             } );

            return 2;

        }

        Error ("$cmd: Element does not exist", "Element: $opt{target}")

            if ( $opt{'require'} );

    }

    else

    {

        #

        #    Target DOES exist

        #       - Good if the user requires the target

        #       - Error unless the user is prepared to delete it

        #

        return 1

                if ( $opt{'require'} || $opt{'test'} || $opt{'create'}  );

        Error ("$cmd: Element exists", "Element: $opt{target}")

            unless ( $opt{'delete'} );

        #

        #   The user has requested that an existing target be deleted

        #

        SvnCmd ($self, 'delete'

                        , $opt{target}

                        , '-m', SvnComment($opt{'comment'},"Deleted by $cmd"),

                        , { 'credentials' => 1,

                            'error' => "$cmd: Element not deleted" } );

    }

    return 0;

}

#-------------------------------------------------------------------------------

# Function        : ProcessRevNo

#

# Description     : Callback function for SvnCmd to Extract a revision number

#                   from the svn command output stream

#

# Inputs          : $self           - Instance data

#                   $line           - Command output

#

#                   Globals:

#

# Returns         : zero - we don't want to kill the command

#

sub ProcessRevNo

{

    my ($self, $line ) = @_;

    if ( $line =~ m~Committed revision\s+(\d+)\.~i )

    {

        $self->{REVNO} = $1;

    } elsif ( $self->{PRINTDATA} ) {

        Message ( $line ) if $line;

    }

    return 0;

}

#-------------------------------------------------------------------------------

# Function        : SvnInfo

#

# Description     : Determine Subversion Info for a specified target

#

# Inputs          : $self               - Instance Data

#                   $url                - Path or URL to get Info on

#                   $tag                - Name of tag within $self to store data

#                                         Currently InfoWs and InfoRepo

#

# Returns         : Non Zero if errors detected

#                   Authentication errors are always reported

#

sub SvnInfo

{

    my ($self, $url, $tag) = @_;

    Error ("Internal: SvnInfo. No Tag provided") unless ( defined $tag );

    Error ("Internal: SvnInfo. No URL provided") unless ( defined $url );

    #

    #   Only call  once

    #       Must simulate a good call

    #

    if ( exists $self->{$tag} )

    {

#DebugDumpData("MeCache: $tag", $self );

        $self->{ERROR_LIST} = [];

        return 0;

    }

    #

    #   Get basic information on the target

    #

    $self->{'infoTag'} = $tag;

    $self->{$tag}{SvnInfoPath} = $url;

    my $rv = $self->SvnCmd ('info', $url, '--depth', 'empty'

                    , { 'credentials' => 1,

                        'nosavedata' => 1,

                        'process' => \&ProcessInfo

                    }

     );

    delete $self->{$tag} if ( @{$self->{ERROR_LIST}} );

    delete $self->{'infoTag'};

#DebugDumpData("Me: $tag", $self );

    return $rv;

}

#-------------------------------------------------------------------------------

# Function        : ProcessInfo

#

# Description     : Process info for SvnInfo

#

# Inputs          : $self           - Instance data

#                   $line           - Command output

#

# Returns         : zero - we don't want to kill the command

#

sub ProcessInfo

{

    my ($self, $line ) = @_;

    Message ( $line ) if $self->{PRINTDATA};

    $line =~ m~(.*?):\s+(.*)~;

    $self->{$self->{'infoTag'}}{$1} = $2;

    return 0;

}

#-------------------------------------------------------------------------------

# Function        : SvnScanPath

#

# Description     : Internal helper function

#                   Scan a directory and split contents into three groups

#

# Inputs          : $self               - Instance data

#                   $cmd                - Command prefix for errros

#                   $path               - Path to test

#

# Returns         : $ref_files          - Ref to array of files

#                   $ref_dirs           - Ref to array of dirs

#                   $ref_svn            - Ref to array of svn dirs

#                   $found              - True: Path found

#

sub SvnScanPath

{

    my $self = shift;

    my ($cmd, $path) = @_;

    my @files;

    my @dirs;

    my @svn;

    Debug ("SvnScanPath");

    Verbose2 ("SvnScanPath: $path");

    #

    #   Read in the directory information

    #   Just one level. Gets files and dirs

    #

    if ( ! SvnTestPath( $self, $cmd, $path, 1 ) )

    {

        #

        #   Path does not exist

        #

        return \@files, \@dirs, \@svn, 0;

    }

    #

    #   Path exists

    #   Sort into three sets

    #       - Svn Directories

    #       - Other Directories

    #       - Files

    #

    foreach ( @{$self->{RESULT_LIST}} )

    {

        if ( $_ eq 'trunk/' || $_ eq 'tags/' || $_ eq 'branches/' ) {

            push @svn, $_;

        } elsif ( substr ($_, -1) eq '/' ) {

            push @dirs, $_;

        } else {

            push @files, $_;

        }

    }

    return \@files, \@dirs, \@svn, 1;

}

#-------------------------------------------------------------------------------

# Function        : SvnTestPath

#

# Description     : Internal helper function

#                   Test a path within the Repo for existance

#                   Optionally read in immediate directory data

#

# Inputs          : $self               - Instance data

#                   $cmd                - Command prefix for errros

#                   $path               - Path to test

#                   $mode               - True: Read in immediate data

#

# Returns         : True  : Path found

#                   False : Path is non-existent in revision

#

#                   May populate @RESULT_LIST with 'immediate' data

#

sub SvnTestPath

{

    my $self = shift;

    my ($cmd, $path, $mode) = @_;

    my $depth = $mode ? 'immediates' : 'empty';

    Debug ("SvnTestPath", @_);

    #

    #   Read in the directory information - but no data

    #

    if ( SvnCmd ( $self, 'list', $path

                        , '--depth', $depth

                        , {'credentials' => 1,}

                        ))

    {

        #

        #   Error occurred

        #   If the path does not exist then this is an error that

        #   we can handle. The path does not exist in the Repository

        #   

        #   Note: Different version of SVN / SVN server generate different

        #         messages. Check many

        #

        foreach my $umsg ( @{$self->{ERROR_LIST}})

        {

            return 0

                if (    $umsg =~ m~' non-existent in that revision$~

                     || $umsg =~ m~' non-existent in revision ~

                     || $umsg =~ m~: No repository found in '~

                     || $umsg =~ m~: Error resolving case of '~

                     || $umsg =~ m~: W160013:~

                     || $umsg =~ m~: E200009:~

                    );

        }

        Error ("$cmd: Unexpected error", @{$self->{ERROR_LIST}});

    }

    return 1;

}

#-------------------------------------------------------------------------------

# Function        : CalcRmReference

#

# Description     : Determine the Release Manager Reference for a SVN

#                   operation

#

# Inputs          : $self                   - Instance data

#                   $target                 - target

#                   $self->{REVNO}          - Revision number

#

# Returns         : RMREF - String Reference

#

sub CalcRmReference

{

    my ($self, $target) = @_;

    Error ("CalcRmReference: No Target") unless ( $target );

    Debug ("CalcRmReference: $target");

    #

    #   Insert any revision information to create a pegged URL

    #

    my $peg = $self->{REVNO} || $self->{WSREVNO};

    $target .= '@' . $peg if $peg;

    #

    #   Attempt to Calculate Release Manager

    #       SourcePath::Tag

    #

    if ( $self->{DEVBRANCH} )

    {

        my $sourcePath = $self->CalcSymbolicUrl($self->FullPath()) . '/' . $self->{DEVBRANCH};

        my $tag = 'Unknown';

        if ( $target =~ m~/tags/(.*)~ ) {

            $tag = $1;

        } else {

            $tag = $peg if ( $peg );

        }

        $self->{SVNTAG} = $sourcePath . '::' . $tag;

    }

    return $self->{RMREF} = $self->CalcSymbolicUrl($target);

}

#-------------------------------------------------------------------------------

# Function        : CalcSymbolicUrl

#

# Description     : Given a URL, return a symbolic URL

#

# Inputs          : $target                 - FULL URL

#

# Returns         : Imput string with a Symbolic URL if possible

#

sub CalcSymbolicUrl

{

    my ($self, $target) = @_;

    #

    #   Take target and remove the reference to the local repository,

    #   if its present. This will provide a ref that we can use on any site

    #

    #   Note: %SVN_URLS values will have a trailing '/'

    #

    #   Sort in reverse order to ensure that the default URL is found last

    #   Do case-insensitive compare. Cut the system some slack.

    #

    foreach my $tag ( @SVN_URLS_LIST )

    {

        if ( $target =~ s~^\Q$SVN_URLS{$tag}\E~$tag/~i )

        {

            $target =~ s~^/~~;

            last;

        }

    }

    return $target;

}

#-------------------------------------------------------------------------------

# Function        : SvnComment

#

# Description     : Create a nice SVN comment from a string or an array

#

# Inputs          : user            - User comment

#                   default         - Default comment

#

#                   Comments may be:

#                       1) A string - Simple

#                       2) An array

#

# Returns         : A string comment

#

sub SvnComment

{

    my ($user, $default) = @_;

    $user = $default unless ( $user );

    return '' unless ( $user );

    my $type = ref $user;

    if ( $type eq '' ) {

        return $user;

    } elsif ( $type eq 'ARRAY' ) {

        return join ("\n", @{$user});

    } else {

        Error ("Unknown comment type: $type");

    }

}

#-------------------------------------------------------------------------------

# Function        : SvnCredentials

#

# Description     : Return an array of login credentials

#                   Used to extend command lines where repository access

#                   is required.

#

#                   There are security implications in using EnvVars

#                   to contain passwords. Its best to avoid their use

#                   and to let cached authentication from a user-session

#                   handle the process.

#

# Inputs          : None

#

# Returns         : An array - may be empty

#

sub SvnCredentials

{

    my @result;

    Verbose2 ("SvnCredentials: $::USER");

    if ( $::GBE_SVN_USERNAME )

    {

        Verbose2 ("SvnCredentials: GBE_SVN_USERNAME : $::GBE_SVN_USERNAME");

        Verbose2 ("SvnCredentials: GBE_SVN_PASSWORD : Defined" ) if ($::GBE_SVN_PASSWORD);

        push @result, '--no-auth-cache';

        push @result, '--username', $::GBE_SVN_USERNAME;

        push @result, '--password', $::GBE_SVN_PASSWORD if ($::GBE_SVN_PASSWORD);

    }

    return @result;

}

#-------------------------------------------------------------------------------

# Function        : SvnCmd

#

# Description     : Run a Subversion Command and capture/process the

#                   output

#

#                   See also SvnUserCmd

#

# Inputs          : $self           - Instance data

#                   Command arguments

#                   Last argument may be a hash of options.

#                       credentials - Add credentials

#                       nosavedata  - Don't save the data

#                       process     - Callback function

#                       printdata   - Print data

#                       error       - Error Message

#                                     Used as first line of an Error call

#

# Returns         : non-zero on errors detected

#                   Authentication errors are detected and always reported

#

sub SvnCmd

{

    my $self = shift;

    Debug ("SvnCmd");

    my $authenicationError;

    #

    #   Extract arguments and options

    #   If last argument is a hesh, then its a hash of options

    #

    my $opt;

    $opt = pop @_

        if (@_ > 0 and UNIVERSAL::isa($_[-1],'HASH'));

    my $savedPrintData = $self->{PRINTDATA};

    $self->{PRINTDATA} = $opt->{'printdata'} if ( exists $opt->{'printdata'} );

    #

    #   All commands are non-interactive, prepend argument

    #   Accept serve certs. Only applies to https connections. VisualSvn

    #   perfers https and it uses self-signed certificates.

    #

    unshift @_, '--non-interactive', '--trust-server-cert';

    # Remove empty arguments.

    @_ = grep { $_ ne '' } @_;

    Verbose2 "SvnCmd $svn @_";

    #

    #   Prepend credentials, but don't show to users

    #

    unshift @_, SvnCredentials() if ( $opt->{'credentials'} );

    #

    # Useful debugging

    #

    # $self->{LAST_CMD} = [$svn, @_];

    #

    #   Reset command output data

    #

    $self->{ERROR_LIST} = [];

    $self->{RESULT_LIST} = [];

#    $self->{LAST_CMD} = \@_;

    #

    #   Make use of a wrapper program to mux the STDERR and STDOUT into

    #   one stream (STDOUT). #   This solves a lot of problems

    #

    #   Do not use IO redirection of STDERR because as this will cause a

    #   shell (sh or cmd.exe) to be invoked and this makes it much

    #   harder to kill on all platforms.

    #

    #   Use open3 as it allows the arguments to be passed

    #   directly without escaping and without any shell in the way

    #

    local (*CHLD_OUT, *CHLD_IN);

    my $pid = open3( \*CHLD_IN, \*CHLD_OUT, '>&STDERR', $stdmux, $svn, @_);

    #

    #   Looks as though we always get a PID - even if the process dies

    #   straight away or can't be found. I suspect that open3 doesn't set

    #   $! anyway. I know it doesn't set $?

    #

    Debug ("Pid: $pid");

    Error ("Can't run command: $!") unless $pid;

    #

    #   Close the input handle

    #   We don't have anything to send to this program

    #

    close(CHLD_IN);

    #

    #   Monitor the output from the utility

    #   Have used stdmux to multiplex stdout and stderr

    #

    #   Note: IO::Select doesn't work on Windows :(

    #   Note: Open3 will cause blocking unless both streams are read

    #         Can read both streams becsue IO::Select doesn't work

    #

    #   Observation:

    #       svn puts errors to STDERR

    #       svn puts status to STDOUT

    #

    while (<CHLD_OUT>)

    {

        s~\s+$~~;

        tr~\\/~/~;

        Verbose3 ( "SvnCmd:" . $_);

        m~^STD(...):(.+)~;

        my $data = $1 ? $2 : $_;

        next unless ( $data );

        if ( $1 && $1 eq 'ERR' )

        {

            #

            #   Process STDERR output

            #

            next if ($data =~ m~^QDBusConnection:~);

            push @{$self->{ERROR_LIST}}, $data;

            $authenicationError = 1 if ( $data =~ m~Could not authenticate~i );

            $authenicationError = 1 if ( $data =~ m~E215004: Authentication failed~i );

            $authenicationError = 1 if ( $data =~ m~E215004: No more credentials~i );

        }

        else

        {

            #

            #   Process STDOUT data

            #

            push @{$self->{RESULT_LIST}}, $data unless ($opt->{'nosavedata'});