If
you have a question on how to do something in Perl, or
you need a Perl solution to an actual real-life problem, or
you're unsure why something you've tried just isn't working...
then this section is the place to ask. Post a new question!
However, you might consider asking in the chatterbox first (if you're a
registered user). The response time tends to be quicker, and if it turns
out that the problem/solutions are too much for the cb to handle, the
kind monks will be sure to direct you here.
there are about 4 links in total, so i wanted to keep it as simple as possible,
looked into parallel::forkmanager, but couldnt get it to work also tried to use the windows command start before curl but that doesent get the page
is there a more simple way to do this?
Hi Monks!
I have to check if an account number is part of a file name and then do some processing if they are a match, but I can't find the best way of doing this, here is a sample code to simulate what I am trying to do:
#!/usr/bin/perl
use strict;
use warnings;
my $filename = "000231263444_01_XY_20130110_061717.txt";
#my $filename = "17034513_01_WQ_20130511_053551.txt";
$filename =~/(^\w+)_(\w{1,2})_(\w{1,2})_(\w+)_(\w+)\.txt$/i;
my $accountnumber = $1;
#test condition
#my $accountnumber = "0";
print "\n *$accountnumber* \n";
#if($filename=~/$accountnumber/gi) {
if($accountnumber=~/$filename/gi) {
print "\n Found - *$accountnumber* - *$filename*\n";
}else{
print "\n Not Found - *$accountnumber* - *$filename*\n";
}
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
my @h = (
{ A => 1, B => undef },
{ A => 2, B => 2 },
{ A => 2, B => undef },
);
$_->{B} ||= $_{A} foreach @h; # Bug!
print Dumper(\@h);
I am trying to use JIRA::Client to update a Jira issue, with partial success.
I have an issue of type "test subcase", which represents the use of a particular test case in a test plan. I am trying to change the custom field there called 'State', between these values: "Passed", "Failed", "In Progress", "Can't Test".
So, I managed to do the update with Perl: and looks (nominally) the same as when I manually do the change through a dialog called "Change Test Case State". However, some things that happened when I made the change manually are missing when I do it with Perl. It must be because there is something I do not know to do either with a different field, or with some aspect of the custom field (or both).
When I do the update manually, via the web client, the change propagates through the display of the state of the test subcase everywhere else, namely the test plan and the parent test case. When I do the update with my Perl script, the change shows up reliably in "Change Test Case State" dialog of the target test subcase, as well as in the history of that subcase, but there is no propagation of the new state to the display of the test subcase's state in other views. In those other views, the old value of 'state' persists (and disagrees with the value in the "Change Test Case State" dialog of the target test subcase.)
I also notice that the history entry is different between a manual change and a change using Perl. In a manual change from "In Progress" to "Can't Test", the History entry looks like this:
Tester, Intrepid made changes - Today 2:22 PM
Status Open [ 1 ] Open [ 1 ]
Test Case State In Progress { "state":"Can't Test","tp":"","tp
+Start":"false"}
I tried to diagnose the problem by comparing a DataDumper of the issue retrieved by JIRA::Client::get_issue both after a manual update and one after a perl update, but there is no significant difference between them.
How can I do this correctly with PERL, so that it behaves more like the manual update, and lets my boss and teammates see that I have tested and recorded my results?
Thank you.
-sailortailorson
Here is all the code:
#!/usr/bin/perl -w
# Sample Perl client accessing JIRA via SOAP using the CPAN
# JIRA::Client module, to update a test case
#
use strict;
use warnings;
use Data::Dumper;
use DateTime;
use JIRA::Client;
use Term::ReadKey;
$|++;
my $ra_states = { a => 'Passed', b =>'Failed', c =>'In Progress', d =>
+ q{Can't Test}, q => 'quit'};
my $s_jira_url = 'https://jira.thankless_employer.com';
my $s_jirauser;
my $s_passwd;
print "\nCorp. login?:\t";
$s_jirauser = ReadLine(0);
chomp $s_jirauser;
ReadMode(2);
print "\nCorp. passwd?:\t";
$s_passwd = ReadLine(0);
chomp $s_passwd;
ReadMode(0);
print "\nThanks...\nNow connecting to $s_jira_url.\n";
my $jira = eval{JIRA::Client->new($s_jira_url, $s_jirauser, $s_passwd)
+} or die("Could not log into $s_jira_url. Here's the problem: $@");
print "Connected.\n";
my $s_target_state = &choose_state($ra_states);
my $command = ".";
if ($s_target_state ne "quit")
{
print "\nEnter a liat of test subcase id's (or \"help\", if you ne
+ed help, or \"state\" if you want to change the target state):\n\n";
}
else
{
exit;
}
my $rh_test_subcases_to_update = {};
while( $command && $command !~ /^N(o|eg|yet|ein|icht)?|Q(uit)?/i )
{
print "\n$s_target_state >> ";
$command = <STDIN>;
chop $command;
if ( $command =~ /^help/i)
{
help();
}
elsif ( $command =~ /\bstate\b/i)
{
$s_target_state = &choose_state($ra_states);
}
elsif ( $command && $command !~ /^N(o|eg|yet|ein|icht)?|Q(uit)?/i)
{
my $s_raw_id;
my @a_raw_ids = split /(?:\s+|\s*?,\s*|\s*?;\s*)/, $command;
foreach $s_raw_id (@a_raw_ids)
{
my $issue;
my @a_errors;
if ($s_raw_id !~ s/^((DS)?-)?(\d+)$/DS-$3/i)
{
push @a_errors, "$s_raw_id does not look like an issue
+ Key."
}
else
{
unless ($issue = eval{ $jira->getIssue($s_raw_id)})
{
push @a_errors, "issue $s_raw_id could not be foun
+d in $s_jira_url: $?";
}
else
{
#unless ( $issue->{type} eq 'Test Subcase' )
#{
# push @a_errors, "issue $s_raw_id is not a 'Te
+st Subcase', but a '" . $issue->{type} . "'.";
#}
unless ( $issue->{type} == 14 )
{
push @a_errors, "issue $s_raw_id is not a '14'
+, but a '" . $issue->{type} . "'.";
}
unless ( $issue->{assignee} eq $s_jirauser )
{
push @a_errors, "issue $s_raw_id is not assign
+ed to '$s_jirauser', but to '" . $issue->{assignee} . "'.";
}
}
}
if ( scalar @a_errors == 0 )
{
if (not exists $rh_test_subcases_to_update->{$s_target
+_state})
{
$rh_test_subcases_to_update->{$s_target_state} = [
+];
}
push @{$rh_test_subcases_to_update->{$s_target_state}}
+, $s_raw_id;
}
else
{
print "\nI cannot set the state of $s_raw_id to $s_tar
+get_state for the following " . (scalar @a_errors > 1 ? "reasons" : "
+reason") . ":\n";
print "\n" . join "\n", @a_errors;
print "\n";
}
}
print "Alright. Any more?\n";
}
}
print "\n$s_jirauser has ended the list.\n";
foreach $s_target_state (keys %{$rh_test_subcases_to_update} )
{
foreach my $s_vetted_key ( @{$rh_test_subcases_to_update->{$s_targ
+et_state}} )
{
$jira->progress_workflow_action_safely( $s_vetted_key, 'Change
+ Test Case State', {custom_fields => { 'customfield_10213' => { '0' =
+> $s_target_state}}}) ;
print "\nChanged test subcase '$s_vetted_key' to '$s_target_st
+ate'.";
}
}
exit;
sub choose_state
{
my $ra_states = shift;
my ($raw_entry, $s_key, $s_state_choice);
$s_key = '';
while( not (exists $ra_states->{$s_key}) )
{
print "\nPlease choose a target state (by letter) from the followi
+ng list:\n\n";
foreach $s_key (sort keys %{$ra_states})
{
print sprintf "%s.\t%s\n", $s_key, $ra_states->{$s_key};
}
print "\n";
$raw_entry = <STDIN>;
chop $raw_entry;
$raw_entry = lc($raw_entry);
if ( $raw_entry =~ /^help/i)
{
help();
}
elsif ( exists $ra_states->{$raw_entry} )
{
$s_key = $raw_entry;
$s_state_choice = $ra_states->{$s_key};
print "\n$s_jirauser chose $s_key: $s_state_choice...\n\n"
+;
}
else
{
print "\nSorry, I did not understand your choice: $raw
+_entry\n";
}
}
exit if $s_state_choice eq 'quit';
return $s_state_choice;
}
sub help
{
print "\nThis is a utility to do small bulk updates from the c
+ommand line on jira test subcases.\n";
print "\nFirst, choose the state you want to change the curren
+t group of test subcases to.\n";
print "\nThen, enter the test subcase IDs, either in one long
+list, or pressing \"Enter\" after each one.\n";
print "\nYou can change state for assignment at any time, and
+subsequently entered test subcase id's will be set to that state.\n";
print "\nTo prevent errors, this utility checks that the reque
+sted issue exists, is a test subcase, and is assigned to you before";
print "\nit actually makes the change. If for some reason it f
+inds a problem, it alerts you to the problem so you can correct the";
print "\nchoice.";
print "\npress [Enter] to continue...\n";
my $nothing = <STDIN>;
}
I'm using GD to create some images that will blend with a transparent background but things aren't working out right. I'm hoping someone can point out what is wrong.
Here is the code; as you can see there's no anti-aliasing at all.
So, you see what's happening there? $self->publish_notice() is failing (in ways that are also impossible) and putting us into the catch block. We log that we're at point 9.9, and we log the "Notice failed" message. That same message should be thrown as an exception by logdie(), and we don't get to point 9.92 so it looks like the die probably happened. However, up around line 78 where we catch that exception, we get an empty string.
It may be relevant that $self->publish_notice is from a Moose::Role, and that $logger calls in there (it fetches its own logger, and checks it's non-null) don't result in log output.
Anybody have any thoughts? I've gone through our previous discussions of Try::Tiny and I don't see any of the problematic things happening here.
I'm looking for an effective way to extract data from a JSON feed. Feeds are separated line by line instead of an over-encompassing array, so it's throwing me off. Here is an example:
etc....
So instead of something that says DATA [ .......json output....], it is just separated essentially by unique numbers line by line from {} which are not detecting the array. My older code had said something along the lines of:
foreach my $stuff(@{$json->{DATA}}){
my %hash = ();
$hash{subject1} = $stuff->{subject1};
}
Dumping out the hash after pulling all the subjects headers I want NORMALLY would display the value that I can use, but this doesn't work in this format. What is the best way to be able to dump these into a value, the numerical first array header (1, 2, 3, etc), the subjects and their respective values? Thanks!
I have a need to return from a deeply nested function, not to the caller, but to a higher point up the call stack. After grovelling at the feet of Google, I understand that, what I need are "Continuations" - functions that not only specify what to return, but also specify where to return to, up the call stack.
The only way I can think of doing this is by throwing exceptions (say at nesting level 4) and catching them at a specified position up the call chain (say at nesting level 1). But it somehow seems wrong (what if a function between 1 and 4 catches it? What if some other legitimate exceptions are thrown?).
Can I implement continuations in Perl in a more disciplined/organized fashion? If yes, can the wise monks here educate me with an example please?
hi monks. so i have a simple i think question, but i cant find any easy or fast solution, so it is not so simple to me. :p
Say, there is this scenario, where you have a variable which contains a string full of ones and zeroes like:
What do you think would be the quickest, not only for the cpu but for writing too, way to create another string, with the number of continual zeroes in it. Let's say for the above $string, to create a new one with this format:
where 1 is for the first zero in $string, 2 for the 2 zeroes in third and fourth place, 4 for the 4 zeroes in 8th, 9th, 10th, and 11th place. etc...
I m really sorry if you cant really make out what i mean, but english is not my native language. Any help would be appreciated.
