Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
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
Uninitialized value in substr command
4 direct replies — Read more / Contribute
by lmtaylor
on Aug 20, 2014 at 17:09

    Hello. I'm trying to take a very large array and re-format it. The initial array looks something like this:

    >123

    ABD

    CEF

    GHI

    >456

    JKL

    MNO

    >789

    That's obviously simplified, but that's the idea. I want to join the elements between the two lines that begin with '>' and then get rid of the lines that begin with the '>', so my final array looks something like this:

    ABDCEFGHI

    JKLMNO

    Here is the code I've written to do it. My problem is, every time I run it, I get a million errors that all say "Use of uninitialized value in substr at line 19." But I can't figure out what value it's talking about.

    #!/usr/bin/perl -w my @contigfile = (">37","ABC","DEF","GHI","JKL","MNO","PQR","STU","VWX +","YZ",">38"); my $element1 = 0; my $element2 = 0; # print @contigfile; # print substr($contigfile[$element1],0,1); # print $contigfile[$element1]; while ($contigfile[$element1]){ if (substr($contigfile[$element1], 0, 1) eq '>'){ do { ++$element2; } until (substr($contigfile[$element2], 0, 1) eq '>'); $new = join('',@contigfile[($element1 + 1)..($element2 - 1)]); splice @contigfile, $element1, $element2, "$new"; ++$element1; $element2 = $element1; } } print @contigfile; exit;

    I wrote this code to test my method before implementing it in my real program, which will take the array in from an input file. Only I can't figure out what this error is talking about. The commented out print commands work just fine. Does anyone see something that I'm missing?

    Thank you so much for your help!

    - Lisa

Check if a file exists and if not create it
3 direct replies — Read more / Contribute
by Wroof
on Aug 20, 2014 at 16:51

    Good morning Monks,

    I am trying to write up a short test program to learn how to deal with files in Perl before I try and implement it into a program I have already written.

    The idea of the test program is to open a file for appending and if the file does not exist create it and open it. The software in the end will be used to create a log in another program to help me track down an error that is occurring around once every 40-50 days.

    What I have at the moment is just trying to open a file for appending/create the file, and then close the file before testing that it exists. This is all based on the IO:File Lib. The function $fh->open(">> test2.txt") always seams to return true even if the files does not exist and it does not create it either.

    use IO::File; use strict; my $fh; sub test { my $filename = 'test2.txt'; unless (-f $filename) { print "File Exists!"; } else { print "File does not exist"; } } sub openFile { $fh = IO::File->new(); if ($fh->open(">> test2.txt")) { print "file open"; print <$fh>; $fh->close; } else { print "file failed to open"; } } openFile(); test();
Key value pair in hash inside while loop
4 direct replies — Read more / Contribute
by newtoperlprog
on Aug 20, 2014 at 15:34

    Dear All,

    I am trying to assign a key value pair in hash in a while loop. At the end of the loop, when I try to print the hash, it shows me the value as zero.

    Also, I have a tab separated file with 6 columns, is it possible to assign the second column as key and fifth column as value pair?

    Below i am putting my code:

    #!/usr/bin/perl -w + use strict; use warnings; my $ctfile = "ct.tab"; my $dg; my $nt; my $min = 3; my $max = 19; my %hash; open (A, "<", $ctfile) or die "Check the file $!"; while (my $line = <A>) { chomp $line; if ($line =~ /dG\s=\s(.*?)\s/) { $dg = $1; next; } my @temp = split(/\s+/, $line); my $snum = $temp[0]; $nt = $temp[1]; # $nt =~ s/[Tt]/U/g; my $connect = $temp[4]; $hash{$nt} = $connect; } foreach my $key (keys %hash) { print "$key\t$hash{$nt}\n"; }
    300 dG = -62.54 [initially -70.70] gi178893_M23263_rna_300-1 1 G 0 2 0 1 2 A 1 3 0 2 3 A 2 4 0 3 4 U 3 5 0 4 5 U 4 6 0 5 6 C 5 7 0 6 7 C 6 8 0 7 8 G 7 9 34 8 9 G 8 10 33 9 10 C 9 11 0 10 11 G 10 12 32 11 12 G 11 13 31 12 13 A 12 14 0 13 14 G 13 15 30 14 15 A 14 16 29 15 16 G 15 17 28 16 17 A 16 18 27 17 18 A 17 19 26 18 19 C 18 20 25 19

    I really appreciate your help. Regards

Dumb question...probably...
2 direct replies — Read more / Contribute
by kepler
on Aug 20, 2014 at 15:11
    Hello, I'm trying to assign variables to a DateTime module like this:
    $dt = DateTime->new( year => $year, month => $month, day => $day, hour => $hour, minute => $minutes, second => $seconds, );
    which gives undef to all variables, although the values are not empty. Sorry to ask: but how do I do this right? Kind regards, Kepler
Multiple File Handles open and active
No replies — Read more | Post response
by tnteverett
on Aug 20, 2014 at 14:53
    http://cpansearch.perl.org/src/SULLR/Net-Inspect-0.303/tools/rtpxtract.pl

    This files uses "$self->{$fh}" to identify file handles for writing. the problem is I need an infinite number to be available while I read RTP and extract any number of separate audio streams to be written to separate audio files

    How is this variable assigned and how do I open multiple file handles for the streams as they are detected in the RTP?

    My version of the code is attached below.

    This code produces only two file handles for the first and second SSRC values.
    #!/usr/bin/perl use strict; use warnings; use Socket; use Getopt::Long qw(:config posix_default bundling); #use Net::Pcap qw(:functions); use Net::Pcap; use Net::Inspect::Debug qw(:DEFAULT %TRACE $DEBUG); use Net::Inspect::L2::Pcap; use Net::Inspect::L3::IP; use Net::Inspect::L4::UDP; ###################################################################### +###### # Options ###################################################################### +###### my ($infile,$dev,$nopromisc,@trace,$outdir); GetOptions( 'r=s' => \$infile, 'i=s' => \$dev, 'p' => \$nopromisc, 'h|help' => sub { usage() }, 'd|debug' => \$DEBUG, 'T|trace=s' => sub { push @trace,split(m/,/,$_[1]) }, 'D|dir=s' => \$outdir, ) or usage(); usage('only interface or file can be set') if $infile and $dev; $infile ||= '/dev/stdin' if ! $dev; my $pcapfilter = join(' ',@ARGV); $TRACE{$_} = 1 for(@trace); die "cannot write to $outdir: $!" if $outdir and ! -w $outdir || ! -d +_; sub usage { print STDERR "ERROR: @_\n" if @_; print STDERR <<USAGE; reads data from pcap file or device and extracts rtp streams. Depending on the used codec you might use to convert data afterwards. For G711a: sox -c1 -r8000 -t al in.rtp out.wav Usage: $0 [options] [pcap-filter] Options: -h|--help this help -r file.pcap read pcap from file -i dev read pcap from dev -p do net set dev into promisc mode -D dir extract data into dir, right now only for http re +quests and responses -T trace trace messages are enabled in the modules, option + can be given multiple times, trace is last part of mo +dule name, e.g. tcp, rawip To enable all specify '*' -d|--debug various debug messages are shown USAGE exit(2); } # open pcap ###################################################################### +###### my $err; print "Open PCAP File: $infile\n"; my $pcap = $infile ? pcap_open_offline($infile,\$err) : pcap_open_live +($dev,2**16,!$nopromisc,0,\$err); $pcap or die $err; if ( $pcapfilter ) { print "Apply PCAP Filter: $pcapfilter\n"; pcap_compile($pcap, \(my $compiled), $pcapfilter,0,0xffffffff) == +0 or die "bad filter '$pcapfilter'"; pcap_setfilter($pcap,$compiled) == 0 or die; } # parse hierarchy ###################################################################### +###### my $udp = Net::Inspect::L4::UDP->new(XTract->new); my $raw = Net::Inspect::L3::IP->new($udp); my $pc = Net::Inspect::L2::Pcap->new($pcap,$raw); # Mainloop ###################################################################### +###### my $time; print "Begin Main Loop\n"; pcap_loop($pcap,-1,sub { my (undef,$hdr,$data) = @_; if ( ! $time || $hdr->{tv_sec}-$time>10 ) { $udp->expire($time = $hdr->{tv_sec}); } return $pc->pktin($data,$hdr); },undef); package XTract; use base 'Net::Inspect::Connection'; use Net::Inspect::Debug; use Data::Dumper; my %rtp; sub pktin { my ($self,$data,$meta) = @_; my $m; # are these expected RTP data? print "Check for expected data\n"; my $s = XTract::RTPStream->new($meta,$m); $s->pktin(0,$data,$meta->{time}); return $s; # no connection for packets return; } package XTract::RTPStream; use base 'Net::Inspect::Connection'; use Net::Inspect::Debug; use fields qw(meta fh0 fh1 fh2 fh3); use Data::Dumper; sub new { my ($class,$meta) = @_; #print Dumper(@_); return bless { meta => $meta }, $class; } sub pktin { my ($self,$dir,$data,$time) = @_; #print Dumper(@_); $self->{expire} = $time + 30; # short expiration #print Dumper($self); # extract payload from RTP data my ($vpxcc,$mpt,$seq,$tstamp,$ssrc) = unpack( 'CCnNN',substr( $dat +a,0,12,'' )); print "Dir: $dir\n"; my $fh = "fh$dir"; print "fh: $fh\n"; if ( ! $self->{$fh} ) { my $fname = sprintf "$outdir/%x-%s.%d-%s.%d-%08x.rtp", @{$self +->{meta}}{qw(time saddr sport daddr dport)},$ssrc; open( $self->{$fh},'>',$fname) or die $!; } my $version = ($vpxcc & 0xc0) >> 6; #if ( $version != 2 ) { # debug("RTP version $version"); # return #} print sprintf("RTP Version %s, VPXCC: %s, MPT: %s, SEQ: %s, TS: %s +, SSRC: %08x\n",$version,$vpxcc,$mpt,$seq,$tstamp,$ssrc); # skip csrc headers my $cc = $vpxcc & 0x0f; substr( $data,0,4*$cc,'' ) if $cc; # skip extension header my $xh = $vpxcc & 0x10 ? (unpack( 'nn', substr( $data,0,4,'' )))[1 +] : 0; substr( $data,0,4*$xh,'' ) if $xh; # ignore padding my $padding = $vpxcc & 0x20 ? unpack( 'C', substr($data,-1,1)) : 0 +; my $payload = $padding ? substr( $data,0,length($data)-$padding ): + $data; # XXX if data are lost filling might be useful # XXX no duplicate detection sleep 1; syswrite($self->{$fh},$payload); return; }
how to split file by two new lines (\n\n) and convert it into array
2 direct replies — Read more / Contribute
by kchavan
on Aug 20, 2014 at 14:52
    how to split file by two new lines (\n\n) and convert it into array Input file example: Status_EventId = "" Status_NmosSerial = "" Status_Acknowledged = 0 acknowledgementStatus = "notAck" additionalText = "" specificProblems00 = "" managedobjectInstance00 = "1.3.6.1.4.1.12.2.2.159#1/1.3.6.1.4.1.12.2.2.22#1/1.3.6.1.4.1.12.2.2.0#7863" perceivedSeverity = "warning" neLocationName = "" currentAlarmId = "8557984" lastOccurence = "1408338405832" acknowledgementUserName = "" additionalInfo00 = "RMServiceState =inService" additionalInfo01RMObjectType = "path" notificationType = "alarmRaise" remoteHost = "/10.23.13.153:25061" eventType = "communicationsAlarm" eventTime = "20140818050641" ASid = "3" firstOccurence = "1408338405832" probableCause = "Client Failure" reservationStatus = "notReserved" friendlyName = "B_GSM-R_N0a.12_N11BSC2.01" RawCaptureTimeStamp = 1408338405 Status_EventId = "" Status_NmosSerial = "" Status_Acknowledged = 0 currentAlarmId = "8557984" lastOccurence = "1408338448373" notificationType = "alarmClear" remoteHost = "/10.23.13.153:25061" eventTime = "20140818050723" ASid = "3" firstOccurence = "1408338448373" probableCause = "Client Failure" friendlyName = "B_GSM-R_N0a.12_N11BSC2.01" RawCaptureTimeStamp = 1408338448 Status_EventId = "" Status_NmosSerial = "" Status_Acknowledged = 0 acknowledgementStatus = "notAck" additionalText = "" specificProblems00 = "" managedobjectInstance00 = "1.3.6.1.4.1.12.2.2.159#1/1.3.6.1.4.1.12.2.2.22#1/1.3.6.1.4.1.12.2.2.69#711/1.3.6.1.4.1.12.2.2.70#13258/1.3.6.1.4.1.12.2.2.106#1057529" perceivedSeverity = "major" neLocationName = "" currentAlarmId = "8557985" lastOccurence = "1408338596741" acknowledgementUserName = "" additionalInfo00 = "RMServiceState =notInService" additionalInfo01RMObjectType = "lo-hotrail" notificationType = "alarmRaise" remoteHost = "/10.23.13.153:25061" eventType = "communicationsAlarm" eventTime = "20140818050646" ASid = "3" firstOccurence = "1408338596741" probableCause = "Transport Failure" reservationStatus = "notReserved" friendlyName = "Trail_S42.3_S42.6_01" RawCaptureTimeStamp = 1408338596 Output data format should be as below: additionalInfo00,notificationType,eventType,friendlyName "RMServiceState =notInService","alarmRaise","communicationsAlarm","Trail_S42.3_S42.6_01" The output file should has header and then data from the input file. I am not able to split file into array and assign vlaues to the keys in desired format. Kindly help me
very slow processing
4 direct replies — Read more / Contribute
by sandy105
on Aug 20, 2014 at 12:30

    i am trying to process a largish ~50 mb log file ,however with the current code ,its taking way too long

    i am basically searching for unique id's in second [] and then looping thru whole file looking for keyword and writing to output file..but its taking hours

    my@id; my $date; my $id; my $keyword; my $mess; my @uniqueid; my %seen; #read the file (PLEASE PROVIDE INPUT FILE PATH) open(hanr,"d:/Log.txt")or die"error $!\n"; #digesting the lines @lines = <hanr>; #iterating through the lines foreach $line (@lines) { $line =~ /\[(.+?)\] .* \[(.+?)\] .* \[[^]]+\] \s+ (.*) /x or next +; $id = $2; push (@id , $id); #pushing id to array } #for getting unique user id's foreach $value (@id) { if (! $seen{$value}++ ) { push @uniqueid, $value; } } #OPENING OUTPUT FILE;PROVIDE PATH open (myfile,">D:\\output\\op.txt") or die("error:cannot create $! \n" +); foreach $uniquevalue (@uniqueid) { foreach $line (@lines) { $line =~ /\[(.+?)\] .* \[(.+?)\] .* \[[^]]+\] \s+ (.*) /x or n +ext ; $date = $1; $id = $2; $keyword = $3; if($uniquevalue eq $2 && $keyword eq "Orchestration Started"){ print myfile "$date,$id,$keyword \n"; next; } if($uniquevalue eq $2 && $keyword =~/^Input Message/){ print myfile "$date,$id,"."Input Message to P5 \n"; next; } if($uniquevalue eq $2 && $keyword =~ /^TP Service Request/){ print myfile "$date,$id,"."Service Request \n"; next; } if($uniquevalue eq $2 && $keyword =~/^P5 Move request :/ ){ print myfile "$date,$id,"."Move request \n"; next; } if($uniquevalue eq $2 && $keyword =~/^ProcessName:/){ $mess = substr $keyword , 12; print myfile "$date,$id,$mess \n"; next; } if($uniquevalue eq $2 && $keyword =~/^Process Message :/ ){ my $mess = substr $keyword , 17; print myfile "$date,$id,$mess \n"; next; } } }

    the search for unique id's is fast enough , but for the second block ,the if loops are searching for keyword for each unique id thru the WHOLE file.its painfully slow,how can i improve speed ??

Example rtpextract does not compile
1 direct reply — Read more / Contribute
by tnteverett
on Aug 20, 2014 at 10:15
    http://cpansearch.perl.org/src/SULLR/Net-Inspect-0.303/tools/rtpxtract.pl

    I am not able to resolve a Line 62 Error:

    rtpextract.pl

    Undefined subroutine &main::pcap_open_offline called at ~/bin/rtpextract.pl line 62.

    Anyone know what the problem is here?

    PROBLEM RESOLVED: See responses

Formatting JSON the right way
3 direct replies — Read more / Contribute
by Anonymous Monk
on Aug 20, 2014 at 07:56
    Hi Monks!

    I am working on this code where I need to send json back to some jQuery code. I would like to know if there is better way of doing this, I mean formatting JSON data. Is there anything that could be done better?
    Here is the code sample for your evaluation:
    !/usr/bin/perl use strict; use warnings; use CGI::Carp qw(fatalsToBrowser); use CGI qw(-oldstyle_urls :standard); use DBI; use DBD::ODBC; use Data::Dumper; use JSON; my $q = CGI->new; my $search = $q->param('search') || ""; my $user = "user"; my $pwd = "pwd"; my $dbh = DBI->connect("DBI:ODBC" ,$user ,$pass ,{ PrintError => 0 } ) + or die "Can not connect to ODBC database: $DBI::errstr\n +" ; my $sql = qq{SELECT name,city,state from mytable where name like ? lim +it 5}; my $data_handle = $dbh->prepare($sql); $data_handle->execute($search.'%') or die "SQL Error: $DBI::errstr\ +n"; my %returned_data; while (my $row = $data_handle->fetchrow_hashref()) { $returned_data{'name'} = $row->{NAME}; $returned_data{'city'} = $row->{CITY}; $returned_data{'state'} = $row->{STATE}; } $data_handle->finish; print $q->header(-type => "application/json", -charset => "utf-8"); my $json = encode_json \%returned_data; print $json;

    Thanks for looking!
Threading Web Requests with LWP
2 direct replies — Read more / Contribute
by tip120
on Aug 20, 2014 at 05:23

    Hi there,

    I have a perl-curses based script that essentially connects to a web-based ajax powered chatroom. This script simply allows me to use the chatroom from within my terminal, without needing a web browser. It works, however, I have a small issue.

    It seems when a web request is made, the curses UI just freezes until the request is done. I figure I can solve this by making the web requests fork off into another thread.

    I've tested the code and confirmed that it only happens while waiting for the webserver to respond.

    However, I'm not sure about the easiest way to fix this. I'm using LWP for my web requests. Is there an easy way to make all the LWP HTTP requests thread and return back without having to rewrite a large portion of my code? Is there an easier way to solve the issue? Any advice would appreciated. :)


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 avoiding work at the Monastery: (6)
    As of 2014-08-21 05:40 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The best computer themed movie is:











      Results (127 votes), past polls