view release on metacpan or  search on metacpan

devmgr/dev_rls_tool  view on Meta::CPAN

                # Grabbed the pertinent part in $1 already
                ($key, $val) = split(/\s+/, $1);
                $info{lc $key} = $val;
            }
            $fh->close;
        }
        #
        # Next, comma-separated list of e-mail addresses to notify
        # If they specified email via -e, use that instead of their uid
        #
        $info{email} .= (defined $opts{e} and $opts{e}) ?
            ",$opts{e}" : ",$opts{user}\@$CONFIG{DEVHOST}";
        $info{email} .= ",$acl->{$project}->{EMAIL}"
            if ($acl->{$project}->{EMAIL});
        # Launder the list
        grep($addr{lc $_}++, (split(/[, ]+/, $info{email})));
        delete $addr{''};
        %seen = ();
        for (sort keys %addr)
        {
            /^(.*)@/;
            delete $addr{$_} if ($seen{$1}++);
        }
        $info{email} = join(',', (sort keys %addr));
        #
        # For the sake of feeling secure, we stamp the package on this end
        # with an MD5 checksum, which will be checked on the opposite end
        # by the server tools. Unless we're releasing to hp.com, the really
        # critical corporate server, in which case we use a much weaker,
        # almost laughable checksum.
        # Also, make job directive for hp.com here
	#
        if ($host eq 'www.hp.com')
        {
            $info{crc} = crc_signature $tarfile;
	    $info{job} = uc join(' ',grep $_,($opts{update} ? 'UPDATE' : '',
					      $opts{prod}   ? 'PROD'   : '',
					      $opts{stage}  ? 'STAGE'  : ''));
        }
        else
        {
            $info{md5} = md5_signature $tarfile;
        }
        #
        # Some basic elements such as project name, destination directory,
        # etc.
        #
        $info{name} = $project;
        $info{dest} = "/$project" unless exists $info{dest};
        $info{compressed} = $config->{COMPRESSION};
        # Make sure it makes the rounds
        $info{upload} = 'yes';
        # Lastly...
        $info{user} = $opts{user};
        # Propagate debugging information
        $info{debug} = 'yes' if ($opts{debug});

        #
        # Set up a proxy, if needed
        #
        $ENV{http_proxy} = $CONFIG{HTTP_PROXY} || $ENV{http_proxy} || '';

        #
        # Effect the transfer of the package. The conditional here is solely
        # because of the need to support releases to www.hp.com
        #
        # 990702: There are valid cases where one may wish to run the tool
        #         just to generate the tar file and release ticked. Check for
        #         this via $opts{noxfer}.
        #
        unless ($opts{noxfer})
        {
            #
            # Here lies the challenge: We must select a transport model that
            # will work, based on some unusual limitations:
            #
            #   * HTTP Upload is preferred. Using FTP means using IPC::Open3
            #     and all the hassle of faking tty modes, etc. This is because
            #     of problems trying to compile Perl with SOCKS support, so
            #     we can't use the Net::FTP module, either.
            #   * The www.hp.com host doesn't run our server software, so we
            #     can't use HTTP with them.
            #   * On top of that, packages over a certain size (70Meg fails,
            #     32Meg succeeded a few times) cause problems with the HTTP
            #     method, in that perl dies unexpectedly and quietly at that.
            #   * Why not just use FTP anyway? There are a lot of points at
            #     which it could catch and hang, plus it's necessary to put
            #     in sleep() delays before closing the connection to ensure
            #     that transfer buffers are flushed. Where HTTP lets us send
            #     the informational parameters as part of the POST-request,
            #     for FTP we have to write an explict $pkg.info file and ftp
            #     it, as well.
            #   * Sounds simple, no? Well, we also have to have a certain
            #     amount of information for each method. A host can therefore
            #     be forced into using a given method simply by clearing
            #     the information fields for the other method. So we have to
            #     check that, too.
            #
            if ($host eq 'www.hp.com')
            {
                 $transport = 'ftp';
            }
            elsif (((-s $tarfile) > $THRESHHOLD) or
                   (defined($config->{FTP_USER}) and
                    defined($config->{FTP_PASSWD})))
            {
                $transport = 'ftp';
            }
            elsif (defined($config->{HTTP_AUTH_USER}) and
                   defined($config->{HTTP_AUTH_PASSWD}))
            {
                $transport = 'http'; # default
            }
            else
            {
                warn "$cmd: do_release: Insufficient configuration " .
                    "information to select FTP or HTTP for host $host.\n" .
                    "Skipping upload of $project.\n";
                $did_not_release++;
                next;
            }