view release on metacpan or  search on metacpan

devmgr/dev_rls_tool  view on Meta::CPAN

}

###############################################################################
#
#   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
#
###############################################################################
sub read_config_file
{
    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;
}

###############################################################################
#
#   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
#
###############################################################################
sub read_hostconfig
{
    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)))
        if ($DEBUG & 14); # bxxxx111x