Attachment 883914 Details for Bug 1085152 – Script that creates and renames subcomponents

Script that creates and renames subcomponents

subcomponents.pl (text/plain), 4.42 KB, created by Jason McDonald on 2014-04-08 06:56:43 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Jason McDonald

Created: 2014-04-08 06:56:43 UTC

Size: 4.42 KB

patch

obsolete

>#!/usr/bin/perl
>#
># XMLRPC script attempting to reproduce https://bugzilla.redhat.com/show_bug.cgi?id=1085152
>#
>use 5.010;
>use strict;
>use warnings;
>
>use XMLRPC::Lite;
>use HTTP::Cookies;
>use Data::Dumper;
>
>BEGIN { $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0 }
>
>my $bugzilla = 'https://bz-stage.devel.redhat.com';
>#my $bugzilla = 'https://partner-bugzilla.redhat.com';
>my $bugzilla_url = $bugzilla.'/xmlrpc.cgi';
>my $username = 'user@example.com';
>my $password = 'password_goes_here';
>
>my $cookie_jar = HTTP::Cookies->new();
>
>my $xml = XMLRPC::Lite->new(proxy => $bugzilla_url);
>$xml->transport->cookie_jar($cookie_jar);
>
>my $login_result = login($username, $password);
>if (not defined $login_result) {
>    print "Login failed!\n";
>    exit(1);
>} else {
>    print "Logged in as $username\n";
>}
>
># Step 1: Create a sub-component with two child subcomponents
># SubComponent.create returns a reference to a hash containing one item: "id".
>
>print "Creating top-level subcomponent....";
>my $result = createSubcomponent();
>my $parent_id = defined $result->{id} ? $result->{id} : undef;
>if (defined $parent_id) {
>    print "succeeded (id = $parent_id)\n";
>} else {
>    print "failed\n";
>    exit(1);
>}
>
>print "Creating 1st child subcomponent....";
>$result = createSubsubcomponent($parent_id, 'A1');
>my $child1_id = defined $result->{id} ? $result->{id} : undef;
>if (defined $child1_id) {
>    print "succeeded (id = $child1_id)\n";
>} else {
>    print "failed\n";
>    exit(1);
>}
>
>print "Creating 2nd child subcomponent....";
>$result = createSubsubcomponent($parent_id, 'A2');
>my $child2_id = defined $result->{id} ? $result->{id} : undef;
>if (defined $child2_id) {
>    print "succeeded (id = $child2_id)\n";
>} else {
>    print "failed\n";
>    exit(1);
>}
>
># Step 2: Now try to rename the parent subcomponent
>
>print "Renaming parent subcomponent by Id....";
>
>$result = updateById($parent_id);
>if (defined $result->{subcomponents_updates}) {
>    print "succeeded\n";
>} else {
>    print "failed\n";
>    exit(1);
>}
>
>print "Renaming parent subcomponent by name....";
>
>$result = updateByName($parent_id);
>if (defined $result->{subcomponents_updates}) {
>    print "succeeded\n";
>} else {
>    print "failed\n";
>    exit(1);
>}
>
>print "\nNow inspect the list of subcomponents at " . $bugzilla . "/page.cgi?id=subcomponents/list.html&product=Red%20Hat%20Enterprise%20Linux%206&component=kernel (and don't forget to clean up afterwards)\n";
>
>logout();
>
>exit(0);
>
>sub createSubcomponent{
>    my $call = $xml->call('SubComponent.create', {
>        product => "Red Hat Enterprise Linux 6",
>        component => "kernel",
>        subcomponent => "A",
>        description => "Top-level subcomponent",
>        default_assignee => "jmcdonal\@redhat.com",
>        default_qa_contact => "sgreen\@redhat.com",
>        is_active => 1
>    });
>    say Dumper $call->faultstring if $call->fault;
>    return $call->result();
>}
>
>sub createSubsubcomponent{
>    my $call = $xml->call('SubComponent.create', {
>        product => "Red Hat Enterprise Linux 6",
>        component => "kernel",
>        parent_id => shift,
>        subcomponent => shift,
>        description => "Child subcomponent",
>        default_assignee => "jmcdonal\@redhat.com",
>        default_qa_contact => "sgreen\@redhat.com",
>        is_active => 1
>    });
>    say Dumper $call->faultstring if $call->fault;
>    return $call->result();
>}
>
>sub updateById{
>    my $call = $xml->call('SubComponent.update', {
>        ids => [ shift ],
>        updates => {
>            name => "changeit"
>        }
>    });
>    say Dumper $call->faultstring if $call->fault;
>    return $call->result();
>}
>
>sub updateByName{
>    my $call = $xml->call('SubComponent.update', {
>        names => [
>                 {
>                      product => "Red Hat Enterprise Linux 6",
>                      component => "kernel",
>                      subcomponent => "changeit"
>                 }
>        ],
>        updates => {
>            name => "changeitagain"
>        }
>    });
>    say Dumper $call->faultstring if $call->fault;
>    return $call->result();
>}
>
>sub login {
>    my ($user, $pass) = @_;
>    my $password = shift;
>
>    my $opt_u = $user;
>    my $opt_p = $pass;
>    my $call = $xml->call( 'User.login', { login => $opt_u, password => $opt_p, remember_login => 1 } );
>    return $call->result;
>}
>
>sub logout {
>    my $call = $xml->call('User.logout');
>    say Dumper $call->faultstring if $call->fault;
>    return $call->result;
>}
>
>sub is_logged_in {
>    my $call = $xml->call('User.id');
>    return $call->result;
>}
>
>

Actions: View

Attachments on bug 1085152: 883914