Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Seekers of Perl Wisdom

( #479=superdoc: print w/ replies, xml ) Need Help??

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.

User Questions
Array shuffle code produces 'Modification of non-creatable array value attempted' error
3 direct replies — Read more / Contribute
by Anonymous Monk
on May 29, 2015 at 14:21
    It's been a while since I've played in Perl but I remember the below shuffle code working. However, on the script I'm working on today says there is an error 'Modification of non-creatable array value attempted, subscript -1). The specific line it is complaining about is @$array$i,$j = @$array$j,$i; Any suggestions on how to fix this?
    sub shuffle { my $array = shift; my $i = @$array; while ( --$i ) { my $j = int rand( $i+1 ); @$array[$i,$j] = @$array[$j,$i]; } }
Using Rex::Test::Spec
1 direct reply — Read more / Contribute
by neilwatson
on May 29, 2015 at 12:37

    Greetings,

    Does anyone have examples of Rex::Test::Spec to share? The documentation is slim. How does it know what host to test? How can I test multiple hosts with single test suite? My first try fails:

    #!/usr/bin/env perl use strict; use warnings; use Rex::Test::Spec; describe "CFEngine tests", sub { context process( 'cf-exed' ), sub { like its( 'command' ), qr|\A(/var/cfengine/bin/)?cf-execd\Z|; }; }; done_testing; Run it: $ ./cfengine_test.pl Error loading Rex::Test::Spec::process. at /home/neil/perl5/perlbrew/p +erls/p

    Neil Watson
    watson-wilson.ca

Sending Custom Mass Mail - Fastest Way Possible
5 direct replies — Read more / Contribute
by edimusrex
on May 29, 2015 at 11:05

    I am a little stumped here on what to do. Currently we send out a weekly news letter to all our users but we like the emails to be custom to each user meaning the first line in the body says -- Hi Bob! -- or whatever. I use HTML Template to accomplish this but I can't find a way to do that and send a bulk message to all users using BCC so I am sending 1 message at a time which as you can imagine takes forever. My question is if someone knows a better way to accomplish this?

    Here is the code thus far, you will see it connects to a database to grab users which are subscribed and builds the emails from that


    #!/usr/bin/perl use strict; use warnings; use MIME::Lite; use HTML::Template; use DBI; use Cwd qw( abs_path ); use File::Basename qw( dirname ); use Config::Properties; use Getopt::Long; use Term::ANSIColor; if (scalar $#ARGV == -1) { &usage(); } my %props; &properties(); my ($mail,$list,$remove,$add); GetOptions( 'mail' => \$mail, 'list' => \$list, 'remove' => \$remove, 'add' => \$add, ) or die &usage(); my %connect = ( 'database'=>$props{MySQL_Database}, 'host'=>$props{MySQL_Host}, 'port'=>$props{MySQL_Port}, 'user'=>$props{MySQL_User}, 'password'=>$props{MySQL_Password}, 'file'=>$props{HTML_File}, ); my $dsn = "DBI:mysql:database=$connect{database};host=$connect{host};p +ort=$connect{port}"; my $dbh = DBI->connect( $dsn, $connect{user}, $connect{password} ) or +die "Failed to connect to the database: " . DBI->errstr; my $sql = qq|SELECT `emailAddress`, `firstName` FROM $connect{database +}.`users` WHERE `status` = (SELECT `Id` FROM $connect{database}.`assc +_status` WHERE `Status` = 'FULL') AND `blacklisted` = (SELECT `Id` FR +OM $connect{database}.`assc_blacklist` WHERE `Blacklisted` = 'No') AN +D `unsubscribed` = (SELECT `Id` FROM $connect{database}.`assc_unsubsc +ribed` WHERE `Status` = 'No')|; my $sql_remove = qq|UPDATE $connect{database}.`users` SET `unsubscribe +d` = (SELECT `Id` FROM $connect{database}.`assc_unsubscribed` WHERE ` +Status` = 'Yes') WHERE `emailAddress` = ?|; my $sql_add = qq|UPDATE $connect{database}.`users` SET `unsubscribed` += (SELECT `Id` FROM $connect{database}.`assc_unsubscribed` WHERE `Sta +tus` = 'No') WHERE `emailAddress` = ?|; if($mail) { print "This option will email all subscribed users. Are you sure +you would like to continue? : (yes|no) "; chomp(my $res = <>); if ($res !~ /^yes$/) { print "Closing Script\n"; exit; } my $sth = $dbh->prepare($sql); $sth->execute or die "Failed to execute query:$!"; my $file = HTML::Template->new(filename => $connect{file}); while (my $result = $sth->fetchrow_hashref) { $file->param(USER_NAME => $result->{firstName}); &sendMail($result->{emailAddress},$file->output); } $dbh->disconnect; exit; } if($list) { my $sth = $dbh->prepare($sql); $sth->execute or die "Failed to execute query:$!"; while (my $result = $sth->fetchrow_hashref) { print "$result->{emailAddress}\n"; } $dbh->disconnect; exit; } if($remove) { my $ans = 1; while($ans) { print "Enter email address you would like to remove from list +: "; chomp(my $em = <>); my $sth = $dbh->prepare($sql_remove); $sth->execute($em) or die "Failed to execute query:$!"; print "$em has been unsubscribed!\n\nWould you like to remove +another user? : (yes|no) "; chomp(my $res = <>); if (lc $res !~ /^yes$/ ) { $ans = 0; } } $dbh->disconnect; exit; } if($add) { my $ans = 1; while($ans) { print "Enter email address you would like to add to list : "; chomp(my $em = <>); my $sth = $dbh->prepare($sql_add); $sth->execute($em) or die "Failed to execute query:$!"; print "$em has been subscribed!\n\nWould you like to add anoth +er user? : (yes|no) "; chomp(my $res = <>); if (lc $res !~ /^yes$/ ) { $ans = 0; } } $dbh->disconnect; exit; } sub sendMail{ my $subject = "<subject title goes here>"; my $to = $_[0]; my $body = $_[1]; my $msg = MIME::Lite->new( From => '<someemail@somewhere.com', To => $to, Subject => $subject, Type => 'text/html', Data => $body, ) or die "Error creating multipart container: $!\n"; $msg->send or die "Failed To Send!: $!\n"; print "Message sent!\n"; } sub properties { open my $fh, '<', dirname(abs_path($0))."/mailer.props" || warn "F +ailed to open :$!"; my $properties = Config::Properties->new(); $properties->load($fh); %props = $properties->properties; return; } sub usage { print color("yellow"), "\n$0 Usage :\n", color("reset"); my $message = <<EOF; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ++++++++++++ + + + + + --mail -:- Send weekly email to all users subscribed + + + + + + + + --list -:- List subscribed users by email + + + + + + + + --remove -:- Unsubscribe user from email, requires you to + enter the email address + + + + + + + --add -:- Add user to subscribed list + + + + + + + ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ++++++++++++ EOF print $message; exit; }

    Help is always greatly appreciated. I hope this all makes sense

CPAN frequently reports older module version
1 direct reply — Read more / Contribute
by philgoetz
on May 29, 2015 at 10:56
    Many modules fail when I try to install them in CPAN, including CPAN itself. This may be because my CPAN thinks it has lower versions of many modules. For example,
    cpan[12]> upgrade JSON::PP Package namespace installed latest in CPAN file JSON::PP 2.24000 2.27300 MAKAMAKA/JSON-PP-2.2730 +0.tar.gz Running install for module 'JSON::PP' Running make for M/MA/MAKAMAKA/JSON-PP-2.27300.tar.gz Has already been unwrapped into directory /home/me/.cpan/build/JSON- +PP-2.27300-dwlFCV Has already been made Running make test Has already been tested successfully Running make install Already done cpan[13]> r JSON::PP Package namespace installed latest in CPAN file JSON::PP 2.24000 2.27300 MAKAMAKA/JSON-PP-2.2730 +0.tar.gz cpan[14]> quit Lockfile removed. ]$ rm -rf ~/.cpan/build/JSON-PP-2.27300-dwlFCV ]$ rm -rf ~/perl5/lib/perl5/JSON ]$ rm -rf ~/.cpan/sources/authors/id/M/MA/MAKAMAKA ]$ cpan cpan[1]> r JSON::PP CPAN: Storable loaded ok (v2.20) Going to read '/home/me/.cpan/Metadata' Database was generated on Fri, 29 May 2015 14:17:02 GMT Package namespace installed latest in CPAN file JSON::PP 2.24000 2.27300 MAKAMAKA/JSON-PP-2.2730 +0.tar.gz cpan[2]> force install JSON::PP ... Result: PASS MAKAMAKA/JSON-PP-2.27300.tar.gz /usr/bin/make test -- OK Running make install Prepending /home/me/.cpan/build/JSON-PP-2.27300-ZHQLK0/blib/arch /home +/me/.cpan/build/JSON-PP-2.27300-ZHQLK0/blib/lib to PERL5LIB for 'inst +all' Manifying blib/man1/json_pp.1 Appending installation info to /home/me/perl5/lib/perl5/x86_64-linux-t +hread-multi/perllocal.pod Installing /home/me/perl5/lib/perl5/JSON/PP.pm Installing /home/me/perl5/lib/perl5/JSON/PP/Boolean.pm MAKAMAKA/JSON-PP-2.27300.tar.gz /usr/bin/make install -j17 -- OK cpan[2]> r JSON::PP Package namespace installed latest in CPAN file JSON::PP 2.24000 2.27300 MAKAMAKA/JSON-PP-2.2730 +0.tar.gz
    Why does it keep reporting version 2.24, even after I've removed the module and after I've installed 2.273 again?
Quick regex substitution question
3 direct replies — Read more / Contribute
by jmmach80
on May 29, 2015 at 10:03

    I'm trying to remove/replace all occurrences of a semicolon, except for the very last. I've been messing around with various regular expressions, but I just can't quite get it right.

    Take this example for instance:

    my $string = "I have multiple ; in my string; however I want to keep t +he last one;"

    I need a regular expression that'll remove/substitute all the ; except the last one.

    $string =~ s/<regex>//; print "$string\n"; I have multiple in my string however I want to keep the last one;
Serverspec, but using Perl?
2 direct replies — Read more / Contribute
by neilwatson
on May 29, 2015 at 09:33

    Greetings,

    Do you know if there is a Perl equivilant to Serverspec? If you were to build such tool in Perl how you go about it?

    Neil Watson
    watson-wilson.ca

How to parse perl variable defined in config file
1 direct reply — Read more / Contribute
by udvk009
on May 29, 2015 at 03:27

    dear monks, is there a way to parse perl variable defined in config file which in turn is the sql statement that is read in a file-handle and assigned to the variable which is further executed via a db-handle. To elaborate further.... 1) suppose here is the config file say test_query.sql test_query.sql contains below. The variable $schema & $name are further defined in the master config file that is read separately.

    select * from $schema.app_table where col1 = $name
    2) my main perl script will read this file into a filehandler and assign to a variable that will be further passed to db-handler
    open SQLFILE, $sqlFile or die "Cannot open file $sqlFile : $!\n"; $sqlRef = <SQLFILE>; $sth =$dbh ->prepare($sqlRef); $sth -> execute();
    3) The issue here is i see below error at the prepare call as the perl-variable is not evaluated
    :: DBD::Oracle::db prepare failed: ORA-00911: invalid character (DBD E +RROR: error possibly near <*> indicator at char (<*>$schema.app_table +)
    4) Kindly help me point to right direction on how to go about evaluating the variable from config file. Let me know if you need more information ? Thanks in advance!!

Odometer pattern iterator (in C). (Updated.)
7 direct replies — Read more / Contribute
by BrowserUk
on May 29, 2015 at 02:58

    At its basic, I want to generate all the numbers from 0 .. N; that have M bits set. Ie. N=5, M=3, generate:

    00111 01011 01101 01110 10011 10101 10110 11001 11010 11100

    But not necessarily in that particular order. Ie. order is immaterial so long as they are all generated.

    What I don't want to do is iterate 0 .. N and then count the bits and then eliminate.

    More to the point, what I really need is the positions of the set bits, not the numbers containing them.

    Update: What I actually want is the indices of the set bits; Ie. the second group of numbers in each line below:

    11100 [0 1 2] 11010 [0 1 3] 11001 [0 1 4] 10110 [0 2 3] 10101 [0 2 4] 10011 [0 3 4] 01110 [1 2 3] 01101 [1 2 4] 01011 [1 3 4] 00111 [2 3 4]

    Final complication is that this will be called from Inline::C, for speed, which means calling back into Perl for each iteration would be expensive. In other words, it'll need to be coded in C.

    As C doesn't like returning multiple values; and cannot construct functions-on-the-fly the way we often do with Perl; the interface I'm thinking of is:

    typedef struct { int N, M; char *posns. } POSNS; POSNS *initGenerator( int N, int M ) { POSNS *p = malloc( sizeof( POSNS ) ); p->N = N; p->M = M; p->posns = malloc( M ); for( i = 0; i < M; ++i ) p->posns[ i ] = N - M + i; return posns; } char *iterGenerator( POSNS *p ) { if( done) { free( p->posns ); free( p ); return NULL; } // modify p->posns; ... return p->posns; } POSNS p = initGenerator( n, m ); while( c = iterGenerator( p ) ) { // use c[]. }

    I think this is going to be an odometer pattern iterator; possibly recursive; but beyond that my mind is blank.

    I can convert a Perl solution to C, but it would need to avoid things that can't be done in C, (liek generating subs on the fly).

    Thoughts? Suggestions? Condemnations :)


    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority". I'm with torvalds on this
    In the absence of evidence, opinion is indistinguishable from prejudice. Agile (and TDD) debunked
    P
-e line 1
4 direct replies — Read more / Contribute
by Ignoramus1
on May 28, 2015 at 19:44
    Working on Windows 8 x64 system and continue to run into multiple errors. Copy of command prompt commands and errors listed bellow. Any help would be greatly appreciated.

    C:\Desktop\MSP Project Working Folder\MSP-forward>perl tagcl eaner.pl -minlen 100 -nomatch 3 -verbose -64 -trim_within 100 -log -fastq msp898 3_F09R08.fastq -out tagcleaner_out/msp8983_F09R08_4M2_SWS6.15F -tag5 ACGCTCGACAA AAGCACATTTAATTCATTATCC -tag3 ATGAGTTTCTGGGGTGCTACTACAGTGCT

    Can't find string terminator "'" anywhere before EOF at -e line 1.

    ERROR: input file for -fastq is in UNKNOWN format not in FASTQ format. Try 'perl tagcleaner.pl -h' for more information. Exit program.

    ERROR: Can't open file : No such file or directory

    C:\Desktop\MSP Project Working Folder\MSP-forward>perl -e ta gcleaner.pl -minlen 100 -nomatch 3 -verbose -64 -trim_within 100 -log -fastq msp 8983_F09R08.fastq -out tagcleaner_out/msp8983_F09R08_4M2_SWS6.15F -tag5 ACGCTCGA CAAAAGCACATTTAATTCATTATCC -tag3 ATGAGTTTCTGGGGTGCTACTACAGTGCT

    Can't locate inlen.pm in @INC (@INC contains:

    C:/Strawberry/perl/site/lib C:/Str awberry/perl/vendor/lib C:/Strawberry/perl/lib .). BEGIN failed--compilation aborted.

    C:\Desktop\MSP Project Working Folder\MSP-forward>perl -e "t agcleaner.pl -minlen 100 -nomatch 3 -verbose -64 -trim_within 100 -log -fastq ms p8983_F09R08.fastq -out tagcleaner_out/msp8983_F09R08_4M2_SWS6.15F -tag5 ACGCTCG ACAAAAGCACATTTAATTCATTATCC -tag3 ATGAGTTTCTGGGGTGCTACTACAGTGCT"

    Number found where operator expected at -e line 1, near "minlen 100" (Do you need to predeclare minlen?)

    Number found where operator expected at -e line 1, near "nomatch 3" (Do you need to predeclare nomatch?)

    Number found where operator expected at -e line 1, near "trim_within 100" (Do you need to predeclare trim_within?)

    syntax error at -e line 1, near "minlen 100"

    Search pattern not terminated at -e line 1.

system stdout redirected ok to a file but not to a variable.
5 direct replies — Read more / Contribute
by guybrush
on May 28, 2015 at 16:56

    Hi, I'm trying to run a command on a unix box using system because I need the exit code. but I also need the stdout and stderr. so I try some STDOUT redirection unfortunatelly it works if I redirect to a file:

    open(STDOUT, '>' ,"kk.txt" ) or die "Can't redirect stdout: $!";

    But not when I do it to a variable:

    open(STDOUT, '>' ,\$output ) or die "Can't redirect stdout: $!";

    This is my Testing code:

    #!/usr/bin/perl my $exitcode ; my $output=''; my $error=''; # take copies of the file descriptors open(OLDOUT, ">&STDOUT"); open(OLDERR, ">&STDERR"); #close current outs as per manual of open close(STDOUT) or die "Can't close STDOUT: $!"; close(STDERR) or die "Can't close STDERR: $!"; # redirect stdout and stderr open(STDOUT, '>' ,\$output ) or die "Can't redirect stdout: $!"; #open(STDOUT, '>' ,"kk.txt" ) or die "Can't redirect stdout: $!"; open(STDERR, '>' ,\$error ) or die "Can't redirect stderr: +$!"; printf "Before system\n"; # run the program system("echo I cant get this into a variable"); $exitcode=($? >>8); printf "After System\n"; # close the redirected filehandles close(STDOUT) or die "Can't close STDOUT: $!"; close(STDERR) or die "Can't close STDERR: $!"; # restore stdout and stderr open(STDOUT, ">&OLDOUT") or die "Can't restore stdout: $!"; open(STDERR, ">&OLDERR") or die "Can't restore stderr: $!"; # avoid leaks by closing the independent copies close(OLDOUT) or die "Can't close OLDOUT: $!"; close(OLDERR) or die "Can't close OLDERR: $!"; printf "Exitcode: %d\n" ,($exitcode); printf "still here\n"; print $output ; print $error ;

    Please any help on why it does not work the redirection when is a variable?

    Also if posible. how can I do this without system. remember I need exitcode stdout and stderr and I do not want to do any alter to the actual command to do unix redirections.

    Many many thanks.

    Guybrush.


Add your question
Title:
Your question:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others cooling their heels in the Monastery: (16)
    As of 2015-05-29 20:14 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      In my home, the TV remote control is ...









      Results (593 votes), past polls