IBM®
Skip to main content
    Country/region [select]      Terms of use
 
 
    
     Home      Products      Services & solutions      Support & downloads      My account     
 
developerworks > My developerWorks >  Dashboard > Configuration Management > ... > ClearQuest > 1.5.1.1.1. Global (Perl)
developerWorks
Log In   View a printable version of the current page.
Overview Connect Spaces Forums Wikis
1.5.1.1.1. Global (Perl)
Added by bobdorenfeld, last edited by bobdorenfeld on Mar 26, 2009  (view change)
Labels: 
(None)

1.5.1.1.1.1  How to set a default value of a field based on the username

Create a new global hook and call it in your field choice list hook:

sub DV_Submitted_By_Name {

my ($fieldname) = @_;

my $session = $entity->GetSession();

my $username = $session->GetUserFullName();

$entity->SetFieldValue($fieldname, $username);

}




1.5.1.1.2.1  How to clone a bug with attachments

Create a new global hook and create an action called clone:

# Perl # Perl # Perl # Perl # Perl # Perl # Perl # Perl # Perl # Perl # Perl

sub Defect_Defect_clonerecord {

my($result);
    my($param) = @_;
    # record type name is Defect


my ($session, $entityName, $entityDefObj, $cloneObj, $reflist, $fieldinfoObj);
my ($name, @fieldnames, $field, $fieldtype, $value, $newid, $error);

    $session = $entity->GetSession();
    $entityName = $entity->GetEntityDefName();
#    $session->OutputDebugString("Entity name: $entityName\n");
    $entityDefObj = $session->GetEntityDef("$entityName");
    $name = $entityDefObj->GetName();
    # Create the new defect
    $cloneObj = $session->BuildEntity($entityName);

    # Enumerate the fields and add them to the cloned object
#    $session->OutputDebugString("Field names for $name\n");
    # Reference to array of field names
    $fieldnames = $entityDefObj->GetFieldDefNames();
    foreach $field (@$fieldnames) {
#        $session->OutputDebugString("Field: $field - ");
        $fieldtype = $entityDefObj->GetFieldDefType($field);
#        $session->OutputDebugString("type: $fieldtype\n");
        my $value = $entity->GetFieldValue($field)->GetValue();
#        $session->OutputDebugString("Value = $value\n");
        SWITCH: {
            if ($fieldtype eq "8")  { last SWITCH; }    # ID type
            if ($fieldtype eq "9")  { last SWITCH; }    # STATE type
            if ($fieldtype eq "10") { last SWITCH; }    # JOURNAL type
            if ($fieldtype eq "11") { last SWITCH; }    # DBID type
            if ($fieldtype eq "12") { last SWITCH; }    # QUESTIONMARK type
            if ($fieldtype eq "13") { last SWITCH; }    # STATETYPE type
            if ($fieldtype eq "7") {                    # ATTACHMENT_LIST type
                # code here for dealing with attachments
	my $attachfields = $entity->GetAttachmentFields();
	my $attachfield1 = $attachfields->Item(0);
	my $attachments = $attachfield1->GetAttachments();
	my $numattachments = $attachments->Count();
	if ( $numattachments > 0 ) {
       $session->OutputDebugString("Number of attchements = ".$numattachments."\n");
# Get the cloned attchment object too
	my $C_attachfields = $cloneObj->GetAttachmentFields();
	my $C_attachfield1 = $C_attachfields->Item(0);
	my $C_attachments = $C_attachfield1->GetAttachments();

 for(my $x =0 ;$x <$numattachments ; $x++)
 {
	my $attachment = $attachments->Item($x);
	my $desc = $attachment->GetDescription();

    my $filename = "C:\\temp\\".$attachment->GetFileName();
	# Write the file
	$attachment->Load($filename);
    # Now copy it to the cloned
    if (! $C_attachments->AddAttachment($filename , $desc) )
    {
       $session->OutputDebugString("Error adding attachment to record.\n");
    }
 } # end for
} # end if

				# end attachment code
                last SWITCH; }
            if ($fieldtype eq "6") {                    # REFERENCE_LIST type
                $fieldinfoObj = $entity->GetFieldValue($field);
                $reflist = $fieldinfoObj->GetValueAsList();
                foreach $reflistvalue (@$reflist) {
                    cloneObj->AddFieldValue($field, $reflistvalue);
                }
                last SWITCH; }
            # Other types (SHORT_STRING, MULTILINE_STRING, INT, DATE_TIME, REFERENCE)
            SWITCH1: {
                if ($field eq "is_active")         { last SWITCH1; }
                if ($field eq "version")           { last SWITCH1; }
                if ($field eq "lock_version")      { last SWITCH1; }
                if ($field eq "locked_by")         { last SWITCH1; }
                if ($field eq "is_duplicate")      { last SWITCH1; }
                if ($field eq "unduplicate_state") { last SWITCH1; }
                $cloneObj->SetFieldValue($field, $value);
            } # end SWITCH1
        } # end SWITCH
    } # end foreach

    $error = $cloneObj->Validate();
    if ($error eq "") {
        $cloneObj->Commit();
        $newid = $cloneObj->GetFieldValue("id")->GetValue();
        $result = "Cloned Successfully! New id is $newid.";
    }
    else {
        $result = $error;
    }

	# Put the oldid in the Cloned_From Field
#	$objtoedit = $session->GetEntity("defect", "$newid");
#	$session->EditEntity($objtoedit,"modify");
#	$oldid = $entity->GetFieldValue("id")->GetValue();
#	$objtoedit->SetFieldValue("ClonedFrom","$oldid");
#	$objtoedit->Validate();
#	$objtoedit->Commit();

	# Put the newid in the Cloned_To Field
#	$recobj = $session->GetEntity("defect", "$oldid");
#	$session->EditEntity($recobj,"modify");
#	$newid = $cloneObj->GetFieldValue("id")->GetValue();
#	$oldfieldval = $entity->GetFieldValue("ClonedTo")->GetValue();
#	$recobj->SetFieldValue("ClonedTo","$oldfieldval\n$newid");
#	$recobj->Validate();
#	$recobj->Commit();

    return $result;
}


Global Sort List          

Contributed by Leesa Hicks

GlobalSortList.pl

sub SortList {
    # Parameters
    # $values - newline separated list of values to be sorted
    # $sortType - Type of sort to perform
    my ($valuesList, $sortType) = @_ ;

    # If the list of values to be sorted is empty,
    #  exit without sorting
    unless ($valuesList) {
        return "";
    }

    # Exit if no sorting is to be performed
    if ($sortType eq "None") {
        return $valuesList;
    }

    my @values = split (/\n/, $valuesList);

    if ($sortType =~ /Ascending/) {
        if ($sortType =~ /Alphabetic/) {
            @values = sort @values;
        } elsif ($sortType =~ /Numeric/) {
            @values = sort {$a <=> $b} @values;
        } elsif ($sortType =~ /Versions/) {
            @values = sort VersionCmp @values;
        }
    } else {
        if ($sortType =~ /Alphabetic/) {
            @values = reverse sort @values;
        } elsif ($sortType =~ /Numeric/) {
            @values = reverse sort {$a <=> $b} @values;
        } elsif ($sortType =~ /Versions/) {
            @values = reverse sort VersionCmp @values;
        }
    }

    my $sortedValues = join("\n", @values);
    return $sortedValues;
}


# The source for this subroutine came from
# http://search.cpan.org/~edavis/Sort-Versions-1.5/Versions.pm
sub VersionCmp( $$ ) {
    my @A = ($_[0] =~ /([-.]|\d+|[^-.\d]+)/g);
    my @B = ($_[1] =~ /([-.]|\d+|[^-.\d]+)/g);

    my ($A, $B);
    while (@A and @B) {
        $A = shift @A;
        $B = shift @B;
        if ($A eq '-' and $B eq '-') {
            next;
        } elsif ( $A eq '-' ) {
            return -1;
        } elsif ( $B eq '-') {
            return 1;
        } elsif ($A eq '.' and $B eq '.') {
            next;
        } elsif ( $A eq '.' ) {
            return -1;
        } elsif ( $B eq '.' ) {
            return 1;
        } elsif ($A =~ /^\d+$/ and $B =~ /^\d+$/) {
            if ($A =~ /^0/ || $B =~ /^0/) {
            return $A cmp $B if $A cmp $B;
            } else {
            return $A <=> $B if $A <=> $B;
            }
        } else {
            $A = uc $A;
            $B = uc $B;
            return $A cmp $B if $A cmp $B;
        }   
    }
    @A <=> @B;
}





 
    About IBM Privacy Contact