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