Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

The Monastery Gates

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

Donations gladly accepted

If you're new here please read PerlMonks FAQ
and Create a new user.

New Questions
Send an email attachment
No replies — Read more | Post response
by AmyB
on Jan 19, 2018 at 12:35
    I'm attempting to modify an existing mailsend program to be able to send a file attachment and need some new ideas. I'm not proficient in PERL at all, so please reply in detail.
    #!/usr/bin/perl -w use strict; # for stronger code my $numargs = $#ARGV + 1; if (($numargs > 3) || ($numargs < 1)) { print "usage : mailsend.pl <logfile> [subject] -t\n"; print "syntax : <logfile> is required. [subject] is optional. [-t] specifies to send a copy to maileater\n"; print "example: mailsend.pl /tmp/test.log\n"; print "example: mailsend.pl /tmp/test.log Test!\n"; print "example: mailsend.pl /tmp/test.log Test! -t\n"; exit; } use Net::SMTP; # net SMTP module my($smtp) = Net::SMTP->new('inesg2.alliance.lan',Debug => 1); $smtp->mail('aixreport@countryfinancial.com'); my $host = `uname -a | cut -d " " -f2`; # my $emseater = 't_ca_mailtrigqa@countryfinancial.com'; my $emseater = 'amy.blass@countryfinancial.com'; my $sendto = 'amy.blass@countryfinancial.com'; my $subject; chomp ($host); my $logfile = $ARGV[0]; chomp ($logfile); if ($numargs > 1) { $subject = $ARGV[1]; } else { $subject = join ": ", $host, $logfile; } my $message = `cat $ARGV[0]`; $smtp->data(); $smtp->datasend("Subject: ". $subject . "\n\n"); $smtp->datasend($message); if ((($numargs == 3) | ($numargs == 4)) && ($ARGV[2] eq "-t")) { $smtp->to($emseater); my $emsfile= '/home/unixadmin/emsmksysb.txt'; # $smtp->datasend("MIME-Version: 1.0\n"); # $smtp->datasend("Content-Type: application/text; name=$emsfile +\n"); $smtp->datasend("Content-Disposition: attachment; filename=\"$ +emsfile\"\n"); # print $smtp ; ## system("ls -l"); ## $smtp->datasend("Content-type: text/plain; name=\"$emsfile\"\+ +n"); } else { $smtp->to($sendto); } $smtp->dataend(); $smtp->quit; The basic part of the PERL that is changing is the if ((($numargs == 3 +) section. I've done basic debugging to know it's getting into that + section. My current debug output is the following: root@x1aix500.countrylan.net/>perl mailsend.pl '/home/unixadmin/emsmks +ysb.txt' 'junk' -t Net::SMTP>>> Net::SMTP(2.29) Net::SMTP>>> Net::Cmd(2.26) Net::SMTP>>> Exporter(5.58) Net::SMTP>>> IO::Socket::INET(1.29) Net::SMTP>>> IO::Socket(1.29) Net::SMTP>>> IO::Handle(1.25) Net::SMTP=GLOB(0x201fd5d8)<<< 220 mail1.countryfinancial.com ESMTP Pro +xy Server Ready Net::SMTP=GLOB(0x201fd5d8)>>> EHLO localhost.localdomain Net::SMTP=GLOB(0x201fd5d8)<<< 250-mail1.countryfinancial.com Hello x1a +ix500.countrylan.net [10.78.196.91], pleased to meet you Net::SMTP=GLOB(0x201fd5d8)<<< 250-ENHANCEDSTATUSCODES Net::SMTP=GLOB(0x201fd5d8)<<< 250-PIPELINING Net::SMTP=GLOB(0x201fd5d8)<<< 250-8BITMIME Net::SMTP=GLOB(0x201fd5d8)<<< 250 STARTTLS Net::SMTP=GLOB(0x201fd5d8)>>> MAIL FROM:<aixreport@countryfinancial.co +m> Net::SMTP=GLOB(0x201fd5d8)<<< 250 2.1.0 Sender ok Net::SMTP=GLOB(0x201fd5d8)>>> DATA Net::SMTP=GLOB(0x201fd5d8)<<< 503 5.5.1 Need RCPT (recipient) Net::SMTP=GLOB(0x201fd5d8)>>> Subject: junk Net::SMTP=GLOB(0x201fd5d8)>>> this is a test of the attachment system +under EMS. Net::SMTP=GLOB(0x201fd5d8)>>> . Net::SMTP=GLOB(0x201fd5d8)<<< 500 5.5.1 Command unrecognized: "Subject +: junk" Net::SMTP=GLOB(0x201fd5d8)>>> RCPT TO:<amy.blass@countryfinancial.com> Net::SMTP=GLOB(0x201fd5d8)<<< 500 5.5.1 Command unrecognized: "" Net::SMTP=GLOB(0x201fd5d8)>>> Content-Disposition: attachment; filenam +e="/home/unixadmin/emsmksysb.txt" Net::SMTP=GLOB(0x201fd5d8)>>> . Net::SMTP=GLOB(0x201fd5d8)<<< 500 5.5.1 Command unrecognized: "this is + a test of the attachment system under EMS. " Net::SMTP=GLOB(0x201fd5d8)>>> QUIT Net::SMTP=GLOB(0x201fd5d8)<<< 500 5.5.1 Command unrecognized: "."
    Any help would be great?
Returning columns with SQL::Statement error
2 direct replies — Read more / Contribute
by LalakisOeisagwmenos
on Jan 19, 2018 at 10:28

    Hello, I am sorry for bothering you but trying to execute the paradigm of SQL::Statement::Structure on a Strawberry perl v5.21.1 I had the following error.

    Can't call method "name" on unblessed reference
    The code is the following:
    use SQL::Statement; use Data::Dumper; my $sql = "SELECT a,aa FROM b JOIN c WHERE c=? AND e=7 ORDER BY f D +ESC LIMIT 5,2"; my $parser = SQL::Parser->new(); $parser->{RaiseError}=1; $parser->{PrintError}=0; # $parser->parse("LOAD 'MyLib::MySyntax' "); my $stmt = SQL::Statement->new($sql,$parser); printf "Command %s\n",$stmt->command; printf "Num of Placeholders %s\n",scalar $stmt->params; printf "Tables %s\n",join( ',', map {$_->name} $stmt->tab +les() ); printf "Where operator %s\n",join( ',', $stmt->where->op() ); printf "Limit %s\n",$stmt->limit(); printf "Offset %s\n",$stmt->offset(); printf "Columns %s\n",join( ',', map {$_->name} $stmt->col +umn_defs() );
    Output

    Can't call method "name" on unblessed reference at c:\Users\PasvantidisR\Documents\scripts\perl\test_sql_statement.pl line 17.

    Command SELECT
    Num of Placeholders 1
    Tables b,c
    Where operator AND
    Limit 2
    Offset 5

    Can you please help? Thank you Lalakis Oeisagwmenos
Data extraction with specific keywords
5 direct replies — Read more / Contribute
by neeraj_kr
on Jan 19, 2018 at 01:31

    I am trying to write a Perl code to extract specific keywords from a large data file. I have created an array where those specific keywords were stored. I was trying to read that large file line by line and extract matching keywords and want to store them in a new file. I am pasting my code here as it's not working properly. Help will be appreciated. Thank you.

    $a=`head -1 $ARGV[0]`; @arr=split(/\t/,$a); $col=$#arr; $c=0; @arr1 = ("91:", "86:", "184:", "430:", "391:", "254:", "121:", "192:", + "404:", "12:", "87:", "638:", "417:", "129:", "549:", "548:", "122:" +, "443:", "378:", "365:", "665:", "148:", "185:", "88:", "629:", "6 +37:", "149:", "625:", "635:", "627:", "650:", "468:", "92:", "618:", +"212:", "85:", "628:", "171:", "649:", "15:", "61:", "169:", "104:", +"202:", "523:", "60:", "672:", "291:", "658:", "59:", "547:", "491:", + "234:", "411:", "620:", "581:", "414:", "14:", "412:", "416:", "345: +", "626:", "457:", "72:", "384:", "371:", "9:", "580:", "436:", "356: +", "385:", "58:", "669:", "388:", "386:", "390:", "636:", "619:", "16 +:", "413:", "17:", "524:", "579:", "624:", "90:", "471:", "410:", "55 +1:", "289:", "387:", "531:", "64:", "166:", "211:", "467:", "415:", " +232:", "550:", "362:", "375:", "401:", "359:", "372:", "398:", "360:" +, "364:", "399:", "403:", "373:", "377:", "18:", "118:", "585:", "427 +:", "424:", "586:", "469:", "425:", "429:", "13:", "423:", "500:", "6 +2:", "109:", "19:", "539:", "499:", "532:", "400:", "63:", "361:", "3 +74:", "73:", "449:", "175:", "426:", "89:", "507:", "397:", "389:", " +582:", "475:", "20:", "22:", "541:", "492:", "503:", "555:", "595:", +"596:", "450:", "23:", "611:", "509:", "3:", "485:", "24:", "438:", " +442:", "440:", "484:", "117:", "32:", "437:", "31:", "663:", "339:", +"535:", "21:", "470:", "439:", "525:", "172:", "40:", "65:", "487:", +"50:", "517:", "597:", "545:", "516:", "402:", "347:", "614:", "540:" +, "613:", "346:", "67:", "363:", "583:", "376:", "428:", "71:", "615: +", "332:", "271:", "5:", "508:", "74:"); #print "$m\n"; print $arr[2],"\n"; for($i=1;$i<=$#arr+1;$i++) { foreach $ar(@arr1) { if ($arr[$i] == $ar) { $c[$j]=$i; $j++; # print $j; } #print $arr[1],"\n"; } } open(fh,"$ARGV[0]"); while(<fh>) { chomp $_; @arr2=split(/\,/,$_); foreach $ar(@c) { # print $arr2[$ar],"\t"; } #print "\n"; } close(fh);
apply_all_roles method clobbering MooseX::Log::Log4perl
1 direct reply — Read more / Contribute
by nysus
on Jan 18, 2018 at 10:16

    I have the following:

    { package MyApp; use Moose; use Moose::Util qw( apply_all_roles ); with 'MooseX::Log::Log4perl'; sub BUILD { my $s = shift; # apply_all_roles($s, 'BarCollector'); # if you uncomment this li +ne, logging doesn't work anymore } sub print_something { my $self = shift; $self->log->info('This does not print when apply_all_roles is used +.'); } } { package BarCollector; use Moose::Role # does nothing } #! /usr/bin/env perl use File::HomeDir; use Log::Log4perl; BEGIN { Log::Log4perl->init_once(File::HomeDir->my_home . '/test.cfg') + }; use MyApp; my $app = MyApp->new(); $app->print_something; __END__ # test.cfg config file: log4perl.logger.MyApp=TRACE, LOG log4perl.appender.LOG=Log::Log4perl::Appender::ScreenColoredLevels log4perl.appender.LOG.layout=PatternLayout log4perl.appender.LOG.layout.ConversionPattern=%c - %m%n

    As noted in the comment, when the line that contains apply_all_roles is uncommented, log messages no longer work. There are no errors.

    Update: One other clue is that when I change the first line of the config file to: log4perl.rootLogger=TRACE, LOG

    I get output, though the category looks something like this: Moose.Meta.Class.__ANON__.SERIAL.1

    Any workaround to this?

    Update 2: Possible workaround?

    I discovered if I slap $s->log->trace('print this'); before the apply_all_roles method is called, everything works as expected. Is there a better way?

    $PM = "Perl Monk's";
    $MCF = "Most Clueless Friar Abbot Bishop Pontiff Deacon Curate Priest";
    $nysus = $PM . ' ' . $MCF;
    Click here if you love Perl Monks

Getting attachments from request in perl
2 direct replies — Read more / Contribute
by Stetec
on Jan 18, 2018 at 09:36
    I want to use a form to submit fields of email so server can send it. I use Perl and Mason to handle this. I want a user to be able to add multiple attachments, however I am encountering a problem that I can not solve. This is my code simplified as much as possible and with added check for the attachments. ( After submit I want to stay at the same page, that is why there is a hidden check-box and condition in Init section, so that it does nothing when I visit the page for the first time. )
    <!DOCTYPE html> <html> %foreach (@messages) { <div class="alert"> <% $_ | h %> </div> %} <body> <form action="/Tools/SendEmail.html" name="form" enctype="multi +part/form-data" method=post> <input type="checkbox" id="submited_chck" name="submited" +checked hidden> <input type="file" name="attached_files" id="file_upload_b +tn" multiple> <input type="submit" value="Submit"> </form> </body> </html> <%args> @messages => () $submited => '' </%args> <%init> use strict; use warnings; use CGI; if($submited eq 'on') { my $req = new CGI; my @attachments = $req->param('attached_files'); unless (@attachments) { push @messages, "Attachments do not exist"; } } </%init>
    The problem is that if I do any request before submit and add any number of attachments it does not get the attachment from request and the error message is pushed into array and displayed. It does not push the error message only if I restart apache service and submit the form right after it. Any ideas what can cause this? I posted this also on stack overflow but no-one is able to help. Here is a link to it https://stackoverflow.com/questions/48290475/getting-attachment-from-request-in-perl
Problem with SOAP call using SOAP::Lite and wsdl
1 direct reply — Read more / Contribute
by Anonymous Monk
on Jan 18, 2018 at 04:15

    I'm trying to do a SOAP call to http://www.webservicex.net/ConvertSpeed.asmx

    My code as follows :

    use SOAP::Lite; my $client = SOAP::Lite->new; $client = $client->service( "http://www.webservicex.net/ConvertSpee +d.asmx?wsdl" ); my $soapResp = $client->call( "ConvertSpeed", 100, "kilometersPerhour" +, "milesPerhour" ); if ( $soapResp->fault ) { print $soapResp->faultstring; } else { print $soapResp->result; }

    This gives me the following error :

    A service address has not been specified either by using SOAP::Lite->proxy() or a service description)

    As far as I understand it the service address is obtained from the WSDL. I did however try using
    $client->proxy("http://www.webservicex.net/ConvertSpeed.asmx"), but then I got the following error :

    Server did not recognize the value of HTTP Header SOAPAction: #ConvertSpeed

    Since the WSDL is supposed to handle the service address I removed the $client->proxy() bit and tried
    other stuff. I have been struggling with this for 2 days now so I can't recall everything I tried, but
    I did reduce method chaining a lot from my initial code to what I posted above. I also tried using
    $client->ConvertSpeed(100, "kilometersPerhour", "milesPerhour") directly as I have seen it done this way
    elsewhere, but it seems to not return anything.

    This is running on Perl 5.10 and version 0.714 of SOAP::Lite.
    I have also tested on Perl 5.22.1 and version 1.19.

    I have also confirmed that this SOAP call works in other languages.

HOW CAN i DOWNGRADE DBD::Oracle
3 direct replies — Read more / Contribute
by BillB
on Jan 17, 2018 at 16:48
    I installed the Perl build from active state on my 64 bit windows 7 machine. However I have to be able to connect to an Oracle 8I database using a 10g client. The 10g client can connect to the database with no problems, but when I try to use DBI it says that that version is no longer supported. I looked up the newest version that will support my database and it is version 1.20 I was able to download the 1.20 version for DBD::Oracle from CPAN but following the instructions I can't get it to replace the version used by my 64 bit version of Perl. Does anyone know how to do this. It is very frustrating. By the way version 1.20 will talk to all versions of the database, it just doesn't support the newest bells and whistles.
Memory utilization and hashes
9 direct replies — Read more / Contribute
by bfdi533
on Jan 17, 2018 at 15:53

    I have some code which reads from a file (sometimes 100+ GB) and has to combine rows to create a consolidated output. I used to process the entire file into a hash and then dump the hash at the end of the program.

    The problem with that was, of course, with the very large files, the hash would grow humongous and the program would consume all memory in the system causing it to crash.

    So, trying to solve this problem, I changed the code to output the data as it went, doing my best to make sure that I got all of the row data for consolidation and the did a delete on the hash, thinking I was clearing up memory. But, this does not appear to be the case. Example code:

    my $l; my @vals; my $json; while (<>) { $l = $_; chomp $l; @vals = split /;/, $l; if ($vals[0] =~ /Query/) { $pairs{$vals[1]}{$vals[2]} = $vals[3]; } elsif {$vals[0] =~ /Answer/) { $pairs{$vals[1}{$vals[2]} = $vals[3]; $json = encode_json $pairs{$vals[1]}; print $json."\n"; delete $pairs{$vals[1]}; } }
    Example data:
    Query;1;host;www.example.com Answer;1;ip;1.2.3.4 Query;2;host;www.cnn.com Query;3;host;www.google.com Answer;2;ip;2.3.4.5 Answer;3;ip;3.4.5.6

    Does delete actually remove the storage from the hash?

    Does the memory the hash is using actually get reduced after delete?

    Is there a better way to do this?

    Code updated above per the first reply.

Attaching a balloon message to text on the Text widget
1 direct reply — Read more / Contribute
by Anonymous Monk
on Jan 17, 2018 at 05:22

    Hi Monks

    I am trying to attach a Balloon to a text (word) in a Text widget. I am not quite sure this is possible, as it seems to me that it is possible to attach it only to a widget. I am able to highlight the word (in this example in red), but how can I attach a Balloon to it? Any idea?

    use strict; use warnings; use Tk; use Tk::Text; use Tk::Balloon; my $mw = tkinit(); my $text = $mw->Text()->pack(); $text->insert('end',"This is a red text\n"); $text->tagAdd('red_text',"1.10","1.13"); $text->insert('end',"This is a black text\n"); $text->tagConfigure('red_text', -foreground => 'red'); my $balloon = $text->Balloon(); $balloon ->attach($text , -balloonmsg => "hello", -initwait=>10); $mw->MainLoop();
SEQUENTIAL REBOOT ORDER WINDOW$
2 direct replies — Read more / Contribute
by 3dbc
on Jan 16, 2018 at 16:18
    Hi perl Monks,

    Unfortunately we all don't have the privilege of working on linux or solaris all the time but still love to use perl to do everything! personally I hate powershell especially when window$ people tell me to use it instead of perl, vbscript is cumbersome, and batch files just plain suck most of the time because they aren't very extendable, robust or creative. There's a lot of published powershell scripts on this topic which read from a csv file that has hostnames and user id / passwords, which I could easily build into this, but just wanted to get something out there because a google search on "perl windows reboot" script returns nothing...

    I wrote a quick and dirty reboot script, planning to expand it a bit more to parse log files, make net service calls, ping ip address to confirm each server is up before moving to the next depending on the underlying software dependencies which created the need for this in the first place, but trying to build in some basic error handling, which will help me expand this further. On my first go, I received a hickup from one of the servers complaining about:

    The handle is invalid. Error communicating with PsExec service on Blah.Blah.Blah
    When I logged onto the server I saw a whole bunch of dll errors, which usually happens after windows patches have been deployed but the server wasn't rebooted, so therefore psexec call didn't work...

    I want to be able to process this output and if I don't get the response:

    cmd started on Blah.Blah.Blah with process ID 4428.


    then I want to terminate the program. I'm calling the command with a
    print for qx|$externalExe 2>&1|;
    How do I process this output within the perl script to exit gracefully (or try alternative methods) when an error is encountered? Perhaps I'm not totally understanding this 2>&1 part of my qx, can I read this output within the script?
    Thanks!

    Sample Code:
    #!/usr/bin/perl use strict; use warnings; my @servers = qw( Blah.Blah.Blah Blah1.Blah.Blah Blah2.Blah.Blah Blah3.Blah.Blah Blah4.Blah.Blah ); foreach (@servers){ my $externalExe = qq(psexec.exe \\\\$_ ); $externalExe .= q(-u BLAH\foo -p secret -i -d cmd /c shutdown /r /f /t + 0); print "\n\nStarting external program...\n"; print for qx|$externalExe 2>&1|; # Executes the program, and prints it +'s output print "Program $externalExe run completed.\n"; sleep 360; }
    - 3dbc
Recognizing pattern in 2D grid
3 direct replies — Read more / Contribute
by pwagyi
on Jan 15, 2018 at 21:42
    Greeting monks!

    I am facing a problem in recognizing a pattern in 2 dimensional grid. 2D grid is represented by hash of hash (X,Y coordinate as key, and value). I need to recognize some patterns like (horizontal, vertical, or diagonal) example data (x,y coordinate and value (a,b,c,..))

    recognize( pattern => 'horizontal', min => 3); # recognize 3 or more +consecutive horizontal pattern recognize( pattern => 'vertical', min => 5); |a|a|b|a|c| |a|a|c|e|f| |e|f|a|1|b|

Perl Variables storage location and scope question.
6 direct replies — Read more / Contribute
by pritesh
on Jan 15, 2018 at 15:42

    Respected Monks,

    I wanted to confirm if a variable delcared in a file is accessible and can be modified throughout the file, even inside a function, and that seems to be true.

    pritesh@mintpad ~ $ more test_var_loc.pl use strict; use warnings; my $val = 10; print "Outside the functions \$val is $val stored at ", \$val, "\n"; sub first { $val = 200; print "In the first function \$val is $val stored at ", \$val, "\n +"; } sub second { $val = 100; print "In the second function \$val is $val stored at ", \$val, "\ +n"; } first(); print "After first function, before second function, \$val is $val st +ored at ", \$val, "\n"; second(); print "After second function, \$val is $val stored at ", \$val, "\n"; pritesh@mintpad ~ $

    The output is as expected.

    pritesh@mintpad ~ $ perl test_var_loc.pl Outside the functions $val is 10 stored at SCALAR(0x1c307c8) In the first function $val is 200 stored at SCALAR(0x1c307c8) After first function, before second function, $val is 200 stored at S +CALAR(0x1c307c8) In the second function $val is 100 stored at SCALAR(0x1c307c8) After second function, $val is 100 stored at SCALAR(0x1c307c8) pritesh@mintpad ~ $

    Now, what I don't get is, if within the function, I declare the $val as my $val (lexical scope), no warning message is shown. Nothing like "masking earlier declaration of $val". It just treats it as if it were a different variable.

    pritesh@mintpad ~ $ more test_my_var_loc.pl use strict; use warnings; my $val = 10; print "Outside the functions \$val is $val stored at ", \$val, "\n"; sub first { my $val = 200; print "In the first function \$val is $val stored at ", \$val, "\n +"; } sub second { my $val = 100; print "In the second function \$val is $val stored at ", \$val, "\ +n"; } first(); print "After first function, before second function, \$val is $val st +ored at ", \$val, "\n"; second(); print "After second function, \$val is $val stored at ", \$val, "\n";

    The output is:

    pritesh@mintpad ~ $ perl test_my_var_loc.pl Outside the functions $val is 10 stored at SCALAR(0xb2d7c8) In the first function $val is 200 stored at SCALAR(0xb2d888) After first function, before second function, $val is 10 stored at SC +ALAR(0xb2d7c8) In the second function $val is 100 stored at SCALAR(0xb2e290) After second function, $val is 10 stored at SCALAR(0xb2d7c8) pritesh@mintpad ~ $

    I am confused. I thought that the second time I would get an error, but then it appears that, each my $var has scope limited to it's function or outside of the function. But if that's the case, I should have gotten an error the first time, stating "the variable requires explicit package name. Did you forget to declare my $var?" or something like that for the $val inside the function(s). I think I am missing something obvious here. Kindly help.

Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (5)
As of 2018-01-19 19:22 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    How did you see in the new year?










    Results (222 votes). Check out past polls.

    Notices?