Subversion Repositories DevTools

Rev

Rev 267 | Rev 297 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 267 Rev 271
Line 68... Line 68...
68
 
68
 
69
#
69
#
70
#   Package Global
70
#   Package Global
71
#
71
#
72
my $svn;                                # Abs path to 'svn' utility
72
my $svn;                                # Abs path to 'svn' utility
-
 
73
my $stdmux;                             # Abs path to stdmux utlity
73
 
74
 
74
#-------------------------------------------------------------------------------
75
#-------------------------------------------------------------------------------
75
# Function        : BEGIN
76
# Function        : BEGIN
76
#
77
#
77
# Description     : Module Initialization
78
# Description     : Module Initialization
Line 96... Line 97...
96
    #   User can provide a path to the svn utility
97
    #   User can provide a path to the svn utility
97
    #   It will be used if its present
98
    #   It will be used if its present
98
    #
99
    #
99
    ::EnvImportOptional('GBE_SVN_PATH', '');
100
    ::EnvImportOptional('GBE_SVN_PATH', '');
100
 
101
 
-
 
102
    $stdmux = LocateProgInPath ( 'stdmux');
-
 
103
    Error ("The JATS stdmux utility cannot be found" ) unless ( $stdmux );
-
 
104
 
101
    $svn = LocateProgInPath ( 'svn', '--All', '--Path=' . $::GBE_SVN_PATH );
105
    $svn = LocateProgInPath ( 'svn', '--All', '--Path=' . $::GBE_SVN_PATH );
102
    Error ("The svn utility cannot be found", "Configured Path: $GBE_SVN_PATH") unless ( $svn );
106
    Error ("The svn utility cannot be found", "Configured Path: $GBE_SVN_PATH") unless ( $svn );
103
}
107
}
104
 
108
 
105
#-------------------------------------------------------------------------------
109
#-------------------------------------------------------------------------------
Line 672... Line 676...
672
    #
676
    #
673
    $self->{ERROR_LIST} = [];
677
    $self->{ERROR_LIST} = [];
674
    $self->{RESULT_LIST} = [];
678
    $self->{RESULT_LIST} = [];
675
 
679
 
676
    #
680
    #
-
 
681
    #   Make use of a wrapper program to mux the STDERR and STDOUT into
-
 
682
    #   one stream (STDOUT). #   This solves a lot of problems
-
 
683
    #
677
    #   Do not use IO redirection of STDERR because as this will cause a
684
    #   Do not use IO redirection of STDERR because as this will cause a
678
    #   shell (sh or cmd.exe) to be invoked and this makes it much
685
    #   shell (sh or cmd.exe) to be invoked and this makes it much
679
    #   harder to kill on all platforms
686
    #   harder to kill on all platforms.
680
    #
687
    #
681
    #   Use open3 as it allows the arguments to be passed
688
    #   Use open3 as it allows the arguments to be passed
682
    #   directly without escaping and without any shell in the way
689
    #   directly without escaping and without any shell in the way
683
    #
690
    #
684
    local (*CHLD_OUT, *CHLD_IN, *CHLD_ERR);
691
    local (*CHLD_OUT, *CHLD_IN);
685
    my $pid = open3( \*CHLD_IN, \*CHLD_OUT, \*CHLD_ERR, $svn, @_);
692
    my $pid = open3( \*CHLD_IN, \*CHLD_OUT, '>&STDERR', $stdmux, $svn, @_);
686
 
693
 
687
    #
694
    #
688
    #   Looks as though we always get a PID - even if the process dies
695
    #   Looks as though we always get a PID - even if the process dies
689
    #   straight away or can't be found. I suspect that open3 doesn't set
696
    #   straight away or can't be found. I suspect that open3 doesn't set
690
    #   $! anyway. I know it doesn't set $?
697
    #   $! anyway. I know it doesn't set $?
Line 698... Line 705...
698
    #
705
    #
699
    close(CHLD_IN);
706
    close(CHLD_IN);
700
 
707
 
701
    #
708
    #
702
    #   Monitor the output from the utility
709
    #   Monitor the output from the utility
-
 
710
    #   Have used stdmux to multiplex stdout and stderr
703
    #
711
    #
704
    #   Note: IO::Select doesn't work on Windows :(
712
    #   Note: IO::Select doesn't work on Windows :(
705
    #
-
 
706
    #   Monitor STDOUT until it gets closed
713
    #   Note: Open3 will cause blocking unless both streams are read
707
    #   Read STDERR once STDOUT runs out
714
    #         Can read both streams becsue IO::Select doesn't work
708
    #
715
    #
709
    #   Observation:
716
    #   Observation:
710
    #       svn puts errors to STDERR
717
    #       svn puts errors to STDERR
711
    #       svn puts status to STDOUT
718
    #       svn puts status to STDOUT
712
    #
719
    #
713
    while (<CHLD_OUT>)
720
    while (<CHLD_OUT>)
714
    {
721
    {
715
        s~\s+$~~;
722
        s~\s+$~~;
716
        tr~\\/~/~;
723
        tr~\\/~/~;
717
        next unless ( $_ );
-
 
718
        Verbose3 ( "SvnCmd resp:\"" . $_ . '"');
-
 
719
        push @{$self->{RESULT_LIST}}, $_ unless ($opt->{'nosavedata'});
-
 
720
 
724
 
-
 
725
        Verbose3 ( "SvnCmd:" . $_);
-
 
726
        m~^STD(...):(.+)~;
-
 
727
        my $data = $1 ? $2 : $_;
-
 
728
        next unless ( $data );
-
 
729
 
-
 
730
        if ( $1 && $1 eq 'ERR' )
721
        #
731
        {
-
 
732
            #
722
        #   If the user has specified a processing function then pass each
733
            #   Process STDERR output
723
        #   line to the specified function.  A non-zero return will
734
            #
724
        #   be taken as a signal to kill the command.
735
            push @{$self->{ERROR_LIST}}, $data;
725
        #
736
        }
726
        if ( exists ($opt->{'process'}) && $opt->{'process'}($self, $_) )
737
        else
727
        {
738
        {
-
 
739
            #
-
 
740
            #   Process STDOUT data
-
 
741
            #
-
 
742
            push @{$self->{RESULT_LIST}}, $data unless ($opt->{'nosavedata'});
-
 
743
 
-
 
744
            #
-
 
745
            #   If the user has specified a processing function then pass each
-
 
746
            #   line to the specified function.  A non-zero return will
-
 
747
            #   be taken as a signal to kill the command.
-
 
748
            #
-
 
749
            if ( exists ($opt->{'process'}) && $opt->{'process'}($self, $data) )
-
 
750
            {
728
            kill 9, $pid;
751
                kill 9, $pid;
729
            last;
752
                last;
-
 
753
            }
730
        }
754
        }
731
    }
755
    }
732
 
756
 
733
    #
-
 
734
    #   Any error messages from the program
-
 
735
    #
-
 
736
    while ( <CHLD_ERR> )
-
 
737
    {
-
 
738
        s~\s+$~~;
-
 
739
        tr~\\/~/~;
-
 
740
        Verbose3 ( "SvnCmd Eresp:" . $_);
-
 
741
        push @{$self->{ERROR_LIST}}, $_;
-
 
742
 
-
 
743
    }
-
 
744
    close(CHLD_OUT);
757
    close(CHLD_OUT);
745
    close(CHLD_ERR);
-
 
746
 
758
 
747
    #
759
    #
748
    #   MUST wait for the process
760
    #   MUST wait for the process
749
    #   Under Windows if this is not done then we eventually fill up some
761
    #   Under Windows if this is not done then we eventually fill up some
750
    #   perl-internal structure and can't spawn anymore processes.
762
    #   perl-internal structure and can't spawn anymore processes.
Line 773... Line 785...
773
    Verbose3 ("Exit Code: $result");
785
    Verbose3 ("Exit Code: $result");
774
 
786
 
775
    return $result;
787
    return $result;
776
}
788
}
777
 
789
 
-
 
790
 
778
#-------------------------------------------------------------------------------
791
#-------------------------------------------------------------------------------
779
# Function        : SvnUserCmd
792
# Function        : SvnUserCmd
780
#
793
#
781
# Description     : Run a Subversion Command for interactive user
794
# Description     : Run a Subversion Command for interactive user
782
#                   Intended to be used interactive
795
#                   Intended to be used interactive