How to write a Perl script in CQ to send emails to the owners of the record type, if the record type is still not in "Closed" state even after 30 days of submission

Answer

The Perl Script uses ClearQuest API and can be run on Windows.

This script works as follows-

• It iterates through all the ClearQuest record type Defect and find all the Defects which are not in "Closed" state.
  
• Out of these Defects, it finds Defects which are older than 30 days of submission.
  
• Then it sends email to corresponding "Owners" of these Defects.

1. Navigate to the location where CQperl.exe is installed.
   
   By default: C:\Program Files\IBM\RationalSDLC\ClearQuest\CQperl.exe
   
   
   
2. Save the following Perl script text to notepad and save with a .pl extension.
   
    

   Disclaimer

   All source code and/or binaries attached to this document are referred to here as "the Program". IBM is not providing program services of any kind for the Program. IBM is providing the Program on an "AS IS" basis without warranty of any kind. IBM WILL NOT BE LIABLE FOR ANY ACTUAL, DIRECT, SPECIAL, INCIDENTAL, OR INDIRECT DAMAGES OR FOR ANY ECONOMIC CONSEQUENTIAL DAMAGES (INCLUDING LOST PROFITS OR SAVINGS), EVEN IF IBM, OR ITS RESELLER, HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.

   
   
   *************************************************************************
   #!C:\Program Files\IBM\RationalSDLC\ClearQuest\CQperl.exe
   # Make sure you have correct path for CQperl.exe
   
   use CQPerlExt;
   my $body;
   
   # Create a Rational ClearQuest admin session my $sessionObj = CQSession::Build();
   
   # Logon as admin
   # Provide correct values for admin password, User Database, and Schema Repository name
   
   $sessionObj->UserLogon("admin", "<AdminPassword>", "<UserDataBase>", <SchemaRepositoryName>");
   
   my $sqlstring = "select distinct
   1.dbid,T1.id,T3.name,T1.headline,T1.submit_date,T2.login_name,T2.email from Defect T1,statedef
   3,users T2 where T1.state = T3.id and T1.owner = T2.dbid and (T1.dbid <> 0 and ((T3.name <>
   'Closed' or T1.state = 0)))";
   
   my $ResultSet = $sessionObj-> BuildSQLQuery($sqlstring);
   
   $ResultSet->EnableRecordCount();
   $ResultSet->Execute();
   $recordCount = $ResultSet->GetRecordCount();
   
   for ($i=0;$i<$recordCount;$i++)
   {
   $status = $ResultSet->MoveNext();
   
   $ClearQuestID[$i]= $ResultSet->GetColumnValue(2);
   $State[$i] = $ResultSet->GetColumnValue(3);
   $Headline[$i] = $ResultSet->GetColumnValue(4);
   $SubmitDate[$i] = $ResultSet->GetColumnValue(5);
   $Owner[$i] = $ResultSet->GetColumnValue(6);
   $OwnerEmail[$i] = $ResultSet->GetColumnValue(7);
   
   my $SubDate = substr($SubmitDate[$i], 0, 10);
   my $days = 30 * 24 * 60 * 60;
   my ($old_day, $old_month, $old_year) = (localtime(time - $days))[3..5];
   my $cutoffDate = sprintf('%04d-%02d-%02d',$old_year + 1900, $old_month + 1, $old_day);
   
   if($SubDate lt $cutoffDate)
   {
   $body = "Attention Please.....The below Defect is opened for more than 30 days. Please do the needful to close it ASAP\n\n";
   $body .= "ID -> $ClearQuestID[$i]\n";
   $body .= "State -> $State[$i]\n";
   $body .= "HeadLine -> $Headline[$i]\n";
   $body .= "SubmitDate -> $SubmitDate[$i]\n";
   $body .= "Owner -> $Owner[$i]\n";
   $body .= "OwnerEmail -> $OwnerEmail[$i]\n\n";
   
   $body .= "Regards,\n";
   $body .= "CQ-Admin";
   
   my $mailmsg = CQMailMsg::Build();
   # provide email server name belowmy @SMTPemailsettings = ('SMTP',"<EnterEmailServerName>",'do.not.reply@CQ.test.com','CQ Admin','1');
   my $setmail_success = $mailmsg->SetMailNotificationSettings(\@SMTPemailsettings);
   my $emailsettings = $mailmsg->GetMailNotificationSettings();
   my @emailsettings = @$emailsettings;
   $mailmsg->AddTo("$OwnerEmail[$i]");
   $mailmsg->SetSubject("CQ Defects - Older than 30 days");
   $mailmsg->SetBody("$body");
   $mailmsg->Deliver();
   CQMailMsg::Unbuild($mailmsg);
   }
   }
   
   #Unbuild the Admin session
   CQPerlExt::CQSession_Unbuild($sessionObj);
   *************************************************************************
   
   
3. Run the following command
   
   cqperl <filename.pl>