view release on metacpan or  search on metacpan

Autodoc/dev_rls_tool_doc.html  view on Meta::CPAN

    my $ret = system @command;
    $ret &= 0xffff;
    #
    # Check for error conditions
    #
    if ($ret == 0xff00)
    {
        # Failure-- not found, etc.
        warn "$cmd: cvs_exec: command 'cvs $op' failed: $!\n";
        return 0;
    }
    elsif ($ret > 0x80)
    {
        # Non-zero exit status from cvs itself
        $ret >>= 8;
        warn "$cmd: cvs_exec: command 'cvs $op' had non-zero exit status " .
            "$ret\n";
        return 0;
    }

    1;
}</pre>
<br><hr><h1>Function: <a name="read_config_file">read_config_file</a></h1>
<h2>Variables:</h2> <ul><li>$1<li>$2<li>$cmd<li>$config<li>$fh<li>$file<li>$line<li>$log_dir<li>$opts</ul>
<h2>Calls:</h2><ul><li> new</ul>
<h2>Comments:</h2> 
 <pre>###############################################################################
#
#   Sub Name:       read_config_file
#
#                   Since this routine is called for almost all invocations,
#                   it is not in the SelfLoader section.
#
#   Description:    Read the configuration file that specifies developer-host
#                   specifics, such as the devault repository, CVS root, etc.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $config   in      hashref   Hash in which key/value pairs
#                                                 are stored
#                   $file     in      scalar    File to read from, defaults
#                                                 to dev_release.cfg
#
#   Globals:        $LOGFILE
#                   $DEBUG
#                   %opts
#                   $log_dir
#
#   Environment:    None.
#
#   Returns:        Success:    1
#                   Failure:    dies
#
###############################################################################/n/n         #
        # If no specific file was passed, use dev_release.cfg in the usual
        # config directory (which is either $opts{d} or $log_dir)
        #
        # skip blanks and comments
        next if ($line =~ /^\s*\#/o);
        # lose leading and trail space
        # if we let them put export or setenv at the head, csh/ksh can also use
        # Actually do something with the line, now...
    # success, we hope</pre>
<h2>Code:</h2> <pre>{
    my $config = shift;
    my $file   = shift;

    unless (defined $file and $file)
    {
        #
        # If no specific file was passed, use dev_release.cfg in the usual
        # config directory (which is either $opts{d} or $log_dir)
        #
        $file = $opts{d} || $log_dir;
        $file .= '/dev_release.cfg';
    }

    my $fh = new IO::File "< $file";
    unless (defined $fh)
    {
        die "$cmd: read_config_file: Could not open $file for reading: $!\n";
    }

    my $line;
    while (defined($line = <$fh>))
    {
        chomp $line;
        # skip blanks and comments
        next if ($line =~ /^\s*$/o);
        next if ($line =~ /^\s*\#/o);
        # lose leading and trail space
        $line =~ s/^\s+//o;
        $line =~ s/\s+$//o;
        # if we let them put export or setenv at the head, csh/ksh can also use
        $line =~ s/^(export|setenv)\s+//o;

        # Actually do something with the line, now...
        if ($line =~ /^(.*?)\s*=\s*(.*)$/o)
        {
            $config->{$1} = $2;
        }
        else
        {
            warn "$cmd: read_config_file: Unknown/misformed line in $file, " .
                "line $.: $line\n";
        }
    }
    $fh->close;

    # success, we hope
    1;
}</pre>
<br><hr><h1>Function: <a name="read_hostconfig">read_hostconfig</a></h1>
<h2>Variables:</h2> <ul><li>$DEBUG<li>$LOGFILE<li>$buf<li>$cmd<li>$data<li>$opts<li>$table<li>%d</ul>
<h2>Calls:</h2><ul><li> DBI_all_mirrors<li>DBI_error<li>data<li>date<li>mirror<li>read<li>write_log_line</ul>
<h2>Comments:</h2> 
 <pre>###############################################################################
#
#   Sub Name:       read_hostconfig
#
#                   Since this routine is called for almost all invocations,
#                   it is not in the SelfLoader section.
#
#   Description:    Read the web-hosts configuration from the Oracle tables.
#                   Return a hash reference to the full data structure, keyed
#                   by host/mirror name.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $table    in/out  hashref   Hash ref to store data into
#
#   Globals:        $LOGFILE
#                   $DEBUG
#                   $log_dir
#                   %opts
#
#   Environment:    None.
#
#   Returns:        Success:    void
#                   Failure:    dies
#
###############################################################################/n/n         if ($DEBUG & 14); # bxxxx111x</pre>
<h2>Code:</h2> <pre>{
    my $table = shift;

    my ($buf, $data);

    $data = DBI_all_mirrors;
    unless (defined $data)
    {
        die "$cmd: read_hostconfig: Error getting full mirror data table: " .
            DBI_error . "\n";
    }
    write_log_line($LOGFILE,
                   sprintf("$opts{date} [$$] DBI mirror data read: %d hosts",
                           scalar(keys %$data)))