ClearQuest Perl API -- Adding a Child Record to another record - perl

I have a ClearQuest database with a record type called "BuildSheet". On a BuildSheet record, you can attach tasks which are another record type.
I thought I could create a task record type, via the BuildEntity Session method, then do a EditEntity Session method on the BuildSheet record, and add the Task Id field via the AddFieldValue Entity method.
Unfortunately, my attempt to create the Type record fails. It gets tripped by the eval statement:
#
# Now Create the Record Type and Fill in the Fields
#
my $record;
eval { $record = $cq->BuildEntity(TASK_RECORD_TYPE); };
if ($#) {
croak qq(Error when attempting to create record type ")
. TASK_RECORD_TYPE . qq("\n$#\n);
}
if (not $record) {
die qq(Cannot create entity ") . TASK_RECORD_TYPE . qq("\n);
}
The eval is failing when I attempt to create the TASK_RECORD_TYPE record. I get the following error message:
Error when attempting to create record type "Task"
Permission denied for user WeintraubH to perform action Create (of type SUBMIT)
at D:/Program Files/Rational/Common/lib/perl5/site_perl/5.8.6/CQPerlExt.pm line 43.
at H:\svn\addTask.cqpl line 340
main::createTask('TASK', 'cm', 'HEADLINE',
'FMS-CWA_APP_B35_HF276', 'DESCRIPTION', 'FMS-CWA_APP_B35_HF276',
'PRIORITY', 2, 'EFFORT', ...) called at H:\svn\addTask.cqpl line 236
Now, I can bring up a BuildSheet record, go into the Child Record tag, click Create and build my task record that way, so apparently I do have permission.
What it seems is that I must somehow associate the "Task" record with a "BuildSheet" before I try to create it, but how?

I found the culprit. They have a hook on the BuildEntity method in order to ensure that the Task record I'm trying to create is connected to a parent record. Stupid *###*$&#.
Anyway I found the hook script (written in VB) and found where they were trying to trip me up:
Set oSession = GetSession
pRequestIDValue = oSession.NameValue("ParentRequestID")
pTaskIDValue = oSession.NameValue("ParentTaskID")
pBuildSheetIDValue = oSession.NameValue("ParentBuildSheetID")
NewTaskPermittedValue = oSession.NameValue("NewTaskPermitted")
curUser = oSession.GetUserLoginName
if (pBuildSheetIDValue <> "") or (pTaskIDValue <> "") _
or ((pRequestIDValue <> "") and (NewTaskPermittedValue = "Yes")) then
task_AccessControl = TRUE
else
task_AccessControl = FALSE
end if
To get around this, I set ParentBuildSheetID with the SetNameValue method before I attempted to create the record:
$cq->SetNameValue("ParentBuildSheetID", $buildsheetId);
my $record;
eval { $record = $cq->BuildEntity(TASK_RECORD_TYPE); };
if ($#) {
croak qq(Error when attempting to create record type ")
. TASK_RECORD_TYPE . qq("\n$#\n);
}
if (not $record) {
die qq(Cannot create entity ") . TASK_RECORD_TYPE . qq("\n);
}
Now, that worked!

No, I don't think you have to associate the Task record with the BuildSheet as you call BuildEntity.
Can you call GetSubmitEntityDefNames and verify that "Task" is in its results?
http://www.ibm.com/developerworks/forums/thread.jspa?threadID=179429 has the closest example I see to what you are trying to do. If so, once you get past the BuildEntity problem, rather than:
then do a EditEntity Session method on the BuildSheet record, and add the Task Id field via the AddFieldValue Entity method.
you want to set the correct relation field on your new Task to the BuildSheet Id before Commit rather than set the Task Id on the BuildSheet record.
I hope this helps; I haven't had to use ClearQuest in more than a decade, so I'm just going by what the (way too scant) documentation says.

Related

evaluate condition assigned to a variable

i am using module Excel::Writer::XLSX and i need to evaluate this condition to check if the sheet was created or not (i need to only execute certain actions if the sheet already exists)
my $sheet = $workbook->add_worksheet($filters{$filter}{description});
how can i do that please ?
knowing that if the sheet already exists, the add_worksheet method "dies" with an error like :
Worksheet name 'All Users', with case ignored, is already used. at ./xxxx.pl line 203.
naturlly, doing something like this doesn't work as i believe it evaluates the variable assignment :
if (my $sheet = $workbook->add_worksheet($filters{$filter}{description});) {
# good, sheet doesn't already exists and was created
# i can place my code here to insert header rows etc./ colors
} else {
# program fires a message like :
# Worksheet name 'XXXXXX', with case ignored, is already used. at XXX
# no need to place code for column headers etc., sheet already exists
}
You could use
my $name = $filters{$filter}{description};
my $sheet =
$workbook->get_worksheet_by_name( $name ) ||
$workbook->add_worksheet( $name );
nvm, i used a hash and i'm checking the hash
if (!$sheets{$filter}) {
$sheets{$filter} = $workbook->add_worksheet($filters{$filter}{description});
works nicely

How can I get Perl DBI's selectrow_hashref to return a new row each iteration?

I am trying to use DBI's selectrow_hashref instead of fetchrow_hashref in order to save a couple lines of code, but it keeps returning the same row of data over and over.
my $select="SELECT * FROM table";
while (my ($user_ref) = $dbh->selectrow_hashref()) {
# $user_ref is the same each time!
}
When I use fetchrow_hashref, everything is fine, and each iteration I get new data.
my $select="SELECT * FROM table";
my $sth = $dbh->prepare($select) || die "prepare: $select: $DBI::errstr";
$sth->execute() || die "execute: $select: $DBI::errstr";
while (my ($user_ref) = $sth->fetchrow_hashref()) {
# works great, new data in $user_ref each iteration
}
Pray tell, what am I doing wrong? Is selectrow_hashref only intended to retrieve a single record? It doesn't seem that way in the doc.
Is selectrow_hashref only intended to retrieve a single record?
Yes.
It doesn't seem that way in the doc.
Well, that documentation says:
It returns the first row of data from the statement.
Which seems pretty clear to me.
Are you looking for selectall_hashref instead?
Update: Actually, I think you want selectall_array:
my $select='SELECT * FROM table';
foreach my $user_ref ($dbh->selectall_array($select, { Slice => {} })) {
# $user_ref is a hash ref
say $user_ref->{some_column};
}

Get Line Items in an Invoice logic hook in SuiteCRM

Via a logic hook I'm trying to update fields of my products, after an invoice has been saved.
What I understand so far is, that I need to get the invoice related AOS_Products_Quotes and from there I could get the products, update the required fields and save the products. Does that sound about right?
The logic hook is being triggered but relationships won't load.
function decrement_stocks ( $bean, $event, $arguments) {
//$bean->product_value_c = $bean->$product_unit_price * $bean->product_qty;
$file = 'custom/modules/AOS_Invoices/decrement.txt';
// Get the Invoice ID:
$sInvoiceID = $bean->id;
$oInvoice = new AOS_Invoices();
$oInvoice->retrieve($sInvoiceID);
$oInvoice->load_relationship('aos_invoices_aos_product_quotes');
$aProductQuotes = $oInvoice->aos_invoices_aos_product_quotes->getBeans();
/*
$aLineItemslist = array();
foreach ($oInvoice->aos_invoices_aos_product_quotes->getBeans() as $lineitem) {
$aLineItemslist[$lineitem->id] = $lineitem;
}
*/
$sBean = var_export($bean, true);
$sInvoice = var_export($oInvoice, true);
$sProductQuotes = var_export($aProductQuotes, true);
$current = $sProductQuotes . "\n\n\n------\n\n\n" . $sInvoice . "\n\n\n------\n\n\n" . $sBean;
file_put_contents($file, $current);
}
The invoice is being retrieved just fine. But either load_relationship isn't doing anything ($sInvoice isn't changing with or without it) and $aProductQuotes is Null.
I'm working on SuiteCRM 7.8.3 and tried it on 7.9.1 as well without success. What am I doing wrong?
I'm not familiar with SuiteCRM specifics, however I'd always suggest to check:
Return value of retrieve(): bean or null?
If null, then no bean with the given ID was found.
In such case $oInvoice would stay empty (Your comment suggests that's not the case here though)
Return value of load_relationship(): true (success) or false (failure, check logs)
And I do wonder, why don't you use $bean?
Instead you seem to receive another copy/reference of $bean (and calling it $oInvoice)? Why?
Or did you mean to receive a different type bean that is somehow connected to $bean?
Then its surely doesn't have the same id as $bean, unless you specifically coded it that way.

Perl -> Avoiding unnecessary method calls

I have to read log files of a store. The log shows the item id and the word "sold" after it. So I made a script to read this file, counting how many times a word "sold" appears for each item id. Turns out that there are many "owners" for the items. That is, there is a relation between "owner_id" (a data in my DB) and "item_id". Im interested in knowing how many items owners sell per day, so I create a "%item_id_owner_map":
my %item_id_sold_times;
my %item_id_owner_map;
open my $infile, "<", $file_location or die("$!: $file_location");
while (<$infile>) {
if (/item_id:(\d+)\s*,\s*sold/) {
my $item_id = $1;
$item_id_sold_times{$item_id}++;
my $owner_ids =
Store::Model::Map::ItemOwnerMap->fetch_by_keys( [$item_id] )
->entry();
for my $owner_id (#$owner_ids) {
$item_id_owner_map{$owner_id}++;
}
}
}
close $infile;
The "Store::Model::Map::ItemOwnerMap->fetch_by_keys( [$item_id] )->entry();" method takes item_id or ids as input, and gives back owner_id as output.
Everything looks great but actually, you will see that every time Perl finds a regex match (that is, every time the "if" condition applies), my script will call "Store::Model::Map::ItemOwnerMap->fetch_by_keys" method, which is very expensive, as these log files are very very long.
Is there a way to make my script more efficient? If possible, I only want to call my Model method once.
Best!
Separate your logic into two loops:
while (<$infile>) {
if (/item_id:(\d+)\s*,\s*sold/) {
my $item_id = $1;
$item_id_sold_times{$item_id}++;
}
}
my #matched_items_ids = keys %item_id_sold_times;
my $owner_ids =
Store::Model::Map::ItemOwnerMap->fetch_by_keys( \#matched_item_ids )
->entry();
for my $owner_id (#$owner_ids) {
$item_id_owner_map{$owner_id}++;
}
I don't know if the entry() call is correct, but the general shape of that code should do it for you.
In general databases are good at fetching sets of rows, so you're right to minimise the calls to fetch from the DB.

Why is this defined value not recognized as a package or object reference?

I have the code below:
my $content = $response->decoded_content((charset => 'UTF-8'));
my $feed = XML::Feed->parse(\$content) || $logger->error("When retrieving $URL: ", XML::Feed->errstr);
if (defined $feed) {
for my $entry ($feed->entries) {
#DO SOMETHING
}
}
For some site, XML::FEED saying that it can't detect the feed type. This is something I have to look at but this is not my question at the moment.
This sample code is inside a while loop has I'm retrieving different RSS and I would like to have the script running even when some URLs failed.
The defined function seems to not work as I get the error message:
Can't call method "entries" without a package or object reference
Can someone tell me what is the right way to handle the test?
You first have to check the value of $feed.
The error message you describe is obvious: $feed is not a package / object reference, but it can be a simple hash for instance. So it's defined.
Add my favourite debugging line right in front of if(defined):
warn Data::Dumper->new([ $feed ],[ '*feed' ])->Sortkeys(1)->Dump();use Data::Dumper;
and you'll see the value in a nice way.
Without testing I'd say that $feed contains the result of your logger, which might be 1 or 0 or something like that, because you set the value of $feed to XML::Feed->parse, and if this is not successful (undefined) it's the result of $logger->error.
You'd better write it like:
my $feed = XML::Feed->parse(\$content);
if (defined $feed) {
for my $entry ($feed->entries) {
#DO SOMETHING
}
}
else {
$logger->error("When retrieving $URL: ", XML::Feed->errstr);
}
because parse is said to return an object, and I guess it returns undef on error.
The error message means what it says: $feed is neither a package nor an object reference. It passes the defined test because there are many defined values which are neither packages nor object references.
In this particular case, you're seeing this error because you are misuing ||:
my $feed = XML::Feed->parse(\$content) || $logger->error("When retrieving $URL: ", XML::Feed->errstr);
If the parse call should fail and return undef, this evaluates to
my $feed = ( undef || $logger->error("When retrieving $URL: ", XML::Feed->errstr) );
which evaluates to
my $feed = $logger->error("When retrieving $URL: ", XML::Feed->errstr);
. The return value of $logger->error is unknown to me, but presumably it is neither a package nor an object reference. And if it were one, it probably would be the wrong one to put in a variable named $feed.
The documentation for XML::Feed mentions parsing with a construct like
my $feed = XML::Feed->parse(URI->new('http://example.com/atom.xml'))
or die XML::Feed->errstr;
This is not the same thing. Their respective precedence rules make || and or suitable for different applications; specifically, you should only use || when you want the value on the right-hand side for something. Do not use it only for the short-circuit side effect.
You can solve this by replacing the || with or to get the right evaluation order. While you are there, you probably should also eliminate the redundant defined test.