Beefy Boxes and Bandwidth Generously Provided by pair Networks vroom
go ahead... be a heretic
 
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
analyzing data
2 direct replies — Read more / Contribute
by matt00perl
on Apr 23, 2014 at 04:22
    i have a data that i got from analysing tcpdump file. the result is below.

    First column is time, follow by src mac, dest_mac, src_ip & src_port and dest_ip_dest_ip.

    i have data from one source ip to a destination ip which appears in different rows, only with the same information except little different in time. Instead of displaying all this information, i will like to loop through the file, if destination ip is the same, record the start time and the end time, the take the difference and print just one row with the difference

    My result at the moment

    <p> 03-23 00:37:28.174515 | 8ca982044d00 | c04a00332142 | 192.168.1.10 +0 | 49671 | 180.149.153.11 | 80 <p> <p> 03-23 00:37:28.174536 | 8ca982044d00 | c04a00332142 | 192.168.1.10 +0 | 49671 | 180.149.153.11 | 80 <p> <p> 03-23 00:41:36.422588 | 8ca982044d00 | c04a00332142 | 192.168.1.10 +0 | 49672 | 180.149.153.11 | 80 <p> <p> 03-23 00:44:18.584080 | 8ca982044d00 | c04a00332142 | 192.168.1.10 +0 | 49671 | 180.149.153.11 | 80 <p> <p> 03-23 00:44:22.588592 | 8ca982044d00 | c04a00332142 | 192.168.1.10 +0 | 35660 | 180.149.134.61 | 80 <p> <p> 03-23 00:45:12.636571 | 8ca982044d00 | c04a00332142 | 192.168.1.10 +0 | 35661 | 180.149.134.61 | 80 <p> <p> What i am expecting instead is: <p> <p> (00:44:22 - 00:37:28) | 8ca982044d00 | c04a00332142 | 192.168.1.10 +0 | 35661 | 180.149.134.61 | 80 <p>

    Any help will be appreciated thank you

How to manage a pattern matching & counting with big data file
4 direct replies — Read more / Contribute
by taj_ritesh
on Apr 23, 2014 at 02:21

    Hi Monks. I have script to process a customized pattern generation & find number of occurrence a selected pattern..

    I am trying this on a file with 15000 page file. It is getting an issue that it is running for a very long time to not getting complete.

    Can you please check the my code & help me to fix this, so it can run quickly & get complete

    #!/usr/bin/perl ############################################### sub get_first_elements_of_string { my @a = (split (' ' ,"$_[0]")); return $a[0]; } ############################################### sub array_search { my ($elem, @arr) = @_; my $flag = -2; $mn = 0; foreach $n (@arr) { if ($n eq $elem) { $flag = $mn; last; } $mn++; } return $flag; } ############################################### sub get_data_path_report { my @spep = (m/ (\S+).*Endpoint: (\S+).*/msg); my $s_p = $spep[0]; my $e_p = $spep[1]; my @data_path = (m/ .*?Endpoint: .*?$s_p(.*?)$e_p.*?data arrival t +ime/msg); my $data_path_length = @data_path; my @A = (); if($data_path_length == 1) { print "\npath:\t $s_p -----to------$e_p-----"; print "size of data_path: $data_path_length\n"; foreach $ele (@data_path) { print "ele------- $ele\n"; my @data_path_elements = (split ('\n',$ele)); my $l = @data_path_elements; print "----- Size of data path elements : $l\n"; shift(@data_path_elements); foreach $x (@data_path_elements) { #@arr = (split (' ',$x)); my $c = &get_first_elements_of_string($x); print "split--ele: $x\n"; print "------\t$c\n"; push (@A,$c); } } print "DATA-PATH-Elements: @A"; #shift(@A); print "#### $#A\n"; return @A; } } ############################################### sub get_patterns { my $sp = $_[0]; my $ep = $_[0]; foreach my $k (2 .. $#_) { if($_[$k] == -2) { next; } if($_[$k] == $ep +1) { $ep = $_[$k]; } else { $sp = $_[$k]; $ep = $_[$k]; } } } ############################################### #open(fh, "timing_report_1.txt"); open(fh, "tim_icc_dec12b"); $/ = "Startpoint:"; my @result = (); while (<fh>) { my @a = (); @a = &get_data_path_report ($_); my %seen = (); push (@result, @a); @result = grep { !$seen{$_}++ } @result; } shift(@result); my $U_L = @result; print "\n\nUNIQUE CELLS: @result ===== $U_L\n"; ############################################### my $k =0; foreach $h (@result) { print "====== $k -----> $h\n"; $k++; } close(fh); ############################################### my $u_l = @result; my $i = 0; my $max_score = -1; my @score_board_matrix = (); while($i < $u_l) { my $score_board_column = ""; my $j = 0; while($j<$u_l) { $score = 0; open(fh, "tim_icc_dec12b"); $/ = "Startpoint:"; while(<fh>) { my @d = &get_data_path_report ($_); if($#d >=1) { my $ss = &array_search("$result[$i]", @d); my $ee = &array_search("$result[$j]", @d); print " !!!! ### $ss ----- $result[$i] <----> $ee ---- +- $result[$j] #### !!!!!\n"; if($ee == $ss+1) { $score++; } } } close(fh); $score_board_column = $score_board_column." ".$score; if($score > $max_score) { $max_score = $score; } print "\n---------------------------$result[$i] $result[$j]--- +-\t$score------> $score_board_column\n"; $j++; } $i++; push (@score_board_matrix, $score_board_column); print "\n"; } ############################################### print "######################\n@score_board_matrix\nMAX_SCORE: $max_sc +ore\n"; my $row = 0; my @array_indexes = (); foreach $column (@score_board_matrix) { my @re = split(" ",$column); my $index = &array_search($max_score,@re); print "\n----- $column------> $#re ------->$row,$index----> $result[$r +ow]<------>$result[$index]\n"; push (@array_indexes, "$index"); $row++; } print "%%%%%%%%%%%%%%%%%%\n"; print "@array_indexes"; my $sp = $array_indexes[0]; my $ep = $array_indexes[0]; print "## $sp ---- $ep\n"; shift(@array_indexes); print @array_indexes; foreach $k (@array_indexes) { if($k == -2) { next; } if($k == $ep +1) { $ep = $k; next; } else { print "PATTERN: $sp ---- $ep"; $e = $sp; while ($e <= $ep) { print "$result[$e]-->"; $e++; } $sp = $k; $ep = $k; } }

    Let me add some detail to make this issue more clear.. The code is getting stuck at following section

    my $u_l = @result; my $i = 0; my $max_score = -1; my @score_board_matrix = (); while($i < $u_l) { my $score_board_column = ""; my $j = 0; while($j<$u_l) { $score = 0; open(fh, "tim_icc_dec12b"); $/ = "Startpoint:"; while(<fh>) { my @d = &get_data_path_report ($_); if($#d >=1) { my $ss = &array_search("$result[$i]", @d); my $ee = &array_search("$result[$j]", @d); print " !!!! ### $ss ----- $result[$i] <----> $ee ---- +- $result[$j] #### !!!!!\n"; if($ee == $ss+1) { $score++; } } } close(fh); $score_board_column = $score_board_column." ".$score; if($score > $max_score) { $max_score = $score; } print "\n---------------------------$result[$i] $result[$j]--- +-\t$score------> $score_board_column\n"; $j++; } $i++; push (@score_board_matrix, $score_board_column); print "\n"; }

    One sample of the target data file is as following :-

    Startpoint: sdram_clk (clock source 'SDRAM_CLK') Endpoint: sd_DQ_out[6] (output port clocked by SD_DDR_CLK) Path Group: COMBO Path Type: max Point Fanout Cap Tra +ns Incr Path -------------------------------------------------------------------- +-------------------------- clock SDRAM_CLK (fall edge) + 3.750000 3.750000 sdram_clk (in) 0.1849 +22 0.065438 & 3.815438 f sdram_clk (net) 17 0.124019 + 0.000000 3.815438 f I_SDRAM_TOP/sdram_clk (SDRAM_TOP) + 0.000000 3.815438 f I_SDRAM_TOP/sdram_clk (net) 0.124019 + 0.000000 3.815438 f I_SDRAM_TOP/I_SDRAM_IF/sdram_clk (SDRAM_IF) + 0.000000 3.815438 f I_SDRAM_TOP/I_SDRAM_IF/sdram_clk (net) 0.124019 + 0.000000 3.815438 f I_SDRAM_TOP/I_SDRAM_IF/bufbdf_G1B1I16/I (bufbd7) 0.1878 +10 0.013919 & 3.829357 f I_SDRAM_TOP/I_SDRAM_IF/bufbdf_G1B1I16/Z (bufbd7) 0.2331 +13 0.210904 & 4.040261 f I_SDRAM_TOP/I_SDRAM_IF/sdram_clk_G1B1I16 (net) 45 0.175550 + 0.000000 4.040261 f I_SDRAM_TOP/I_SDRAM_IF/sd_mux_dq_out_6/S (mx02d4) 0.2340 +98 0.003310 & 4.043571 f I_SDRAM_TOP/I_SDRAM_IF/sd_mux_dq_out_6/Z (mx02d4) 0.9991 +21 0.776377 4.819948 f I_SDRAM_TOP/I_SDRAM_IF/sd_DQ_out[6] (net) 1 0.475020 + 0.000000 4.819948 f I_SDRAM_TOP/I_SDRAM_IF/sd_DQ_out[6] (SDRAM_IF) + 0.000000 4.819948 f I_SDRAM_TOP/sd_DQ_out[6] (net) 0.475020 + 0.000000 4.819948 f I_SDRAM_TOP/sd_DQ_out[6] (SDRAM_TOP) + 0.000000 4.819948 f sd_DQ_out[6] (net) 0.475020 + 0.000000 4.819948 f sd_DQ_out[6] (out) 0.9991 +21 0.010237 & 4.830185 f data arrival time + 4.830185 clock SD_DDR_CLK (rise edge) + 7.500000 7.500000 clock network delay (ideal) + 1.598546 9.098545 clock uncertainty + -0.100000 8.998545 output external delay + -2.000000 6.998545 data required time + 6.998545 -------------------------------------------------------------------- +-------------------------- data required time + 6.998545 data arrival time + -4.830185 -------------------------------------------------------------------- +-------------------------- slack (MET) + 2.168359

    This work I am trying to scan path from start from "Endpoint" to "data arrival time" & then break first column for each line in this section in one pattern, expand this pattern in +/- 2 range the scan each pattern in whole file which is having 1000 such path as shown in example to find out number of times each pattern is getting repeated.

Need help on perl Expect Module
3 direct replies — Read more / Contribute
by sriram83.life
on Apr 23, 2014 at 00:55
    Hello Monks,

    I want to write a script that extracts files in directories and their subdirectories recursively.I have used File::Find module to use wanted() subroutine to extract files recursively.While it recursively extracts,some duplicate files are appearing and asking for prompt to replace or rename. Here is the example prompt.

    replace META-INF/MANIFEST.MF? [y]es, [n]o, [A]ll, [N]one, [r]ename:

    Every time it appears,script has to send "A" reply to the prompt and it has to continue as i need to extract hundreds of files and get the required file.Can any one give me suggestions on how to write this using perl Expect?

    Here is my code which uses File::Find module to find files recursively and perform some actions.

    find( { wanted => \&wanted, }, @dirs); sub wanted { my $depth = $File::Find::dir =~ tr[/][]; return if $depth < $min_depth; if ( $File::Find::name =~ m/.zip$|file.*?$/ ) { print "I am extracting zip file : $File::Find::name\n"; &execute_command("unzip $File::Find::name"); #At this point it asks for prompt,i need to make it accept reply +automatically. #execute_command is a subroutine written in another module which +uses fork and exec to execute a shell command. elsif ( $File::Find::name =~ m/.gz$/ ) { &execute_command("gunzip $File::Find::name"); } }

    Your help is much appreciated.

Using the Math::BigFloat->digit() method
3 direct replies — Read more / Contribute
by Athanasius
on Apr 22, 2014 at 23:51

    I’m using the Math::BigFloat module, and noticed in the documentation’s Synopsis that it has a digit() method:

    $x->digit($n); # return the nth digit, counting from right $x->digit(-$n); # return the nth digit, counting from left

    But I can’t seem to get it to work:

    13:45 >perl -MMath::BigFloat -wE "my $n = Math::BigFloat->new(123); sa +y $n; say $n->digit(-1);" 123 Can't use an undefined value as an ARRAY reference at C:/Perl/Strawber +ry/strawberry-perl-5.18.2.1-64bit-portable/perl/lib/Math/BigInt/Calc. +pm line 1209. 13:45 >p5u v Math::BigFloat Math::BigFloat C:\Perl\Strawberry\strawberry-perl-5.18.2.1-64bit-portable\per +l\lib\Math\BigFloat.pm: 1.998 13:46 >

    What am I doing wrong?

    Athanasius <°(((><contra mundum Iustus alius egestas vitae, eros Piratica,

how to use Algorithm::NaiveBayes module
2 direct replies — Read more / Contribute
by agnes
on Apr 22, 2014 at 22:15
    as the title said, I plan to use Algorithm::NaiveBayes module in Perl to classify sentences (positive, negative or neutral). I have already have the all the sentences and already split these sentence into words. I know the first thing I need to do is to convert the vector of words into a hash variable. But, I do not know how..Is it true I should take the category as hash key and each word as hash variables? I also need to know after converting these vectors of words in to hash variables how to use the Algorithm::NaiveBayes module. Is these anyone can help me to write the code to implement these function. Thanks a lot!!!!!
Okay! What!?!?!?
5 direct replies — Read more / Contribute
by Anonymous Monk
on Apr 22, 2014 at 20:36
    So value 1 is 14.4 and value 2 is 14.4, why is this evaluating to false?? Maybe I'm crazy.
    my $value1 = 14.4; print "value1 = $value1\n"; my $value2 = 10 + 14.4 - 10; print "value2 = $value2\n"; if ( $value1 == $value2 ) { print "value 1 equals value 2\n"; } else { print "value 1 does not equal value2\n"; }
Running blocks of shell script from within perl script
6 direct replies — Read more / Contribute
by lilgreen
on Apr 22, 2014 at 14:39

    I have a hash (%check) with the following content:

    'DESCRIPTION' => 'Checks that various system filesystems are at the mi +nimum size' 'NAME' => 'filesys_sizes' 'TIP' => '(/<filesystem> is less than XGB, increase FS size to minimum +) The /tmp filesystems has a minimum filesystem size of 1GB Increase the filesystem to a minimum of 1GB chfs -a size=2097152 /tmp' 'TIP_NUMBER' => 37 'CHECK_CODE' => ‘#!/usr/bin/ksh93 typeset -A SIZE_MIN SIZE_MIN=([/var]=2097152 [/tmp]=1048576 [/home]=1048576) ISHACMP=$(lslpp -Lqc cluster.*.server.rte 2>/dev/null | grep -c cluste +r) for fs in ${!SIZE_MIN[*]}; do fssize=$(df -k $fs | grep -v Filesystem | awk \'{print $2}\') if (( $fssize < ${SIZE_MIN[$fs]} )); then print "BAD;$fs is less than minimum size ($SIZE_MIN[$fs]}), in +crease to minimum size" elif (( $fssize == ${SIZE_MIN[$fs]} )); then print "GOOD;$fs is at minimum size (${SIZE_MIN[$fs]} kb)" else print "GOOD;$fs is greater ($fssize) than minimum (${SIZE_MIN[ +$fs]})" fi done'

    Here's the subroutine that's actually running the CHECK_CODE element:

    sub exec_check { my (%check) = @_; my @return = `$check{'CHECK_CODE'}`; foreach (@return) { my ($status, $string) = split(";", $_); print "$status $string"; } }

    I want to execute $data{'CHECK_CODE'} as a "chunk" - whatever is in it is run as a whole, and the perl script just handles the data returned from the chunk. I've tried and backticks and qx// and IPC::Run, and even open() but they all seem to have the same limitation - when I pass the hash element as the command to be executed it gets interpreted one line at a time. I always get the same error:

    sh[3]: typeset: 0403-010 A specified flag is not valid for this comman +d.

    On the system this being run on (AIX) this is a valid error for ksh because it doesn't have a -A option for typeset, but ksh93 does support -A so it's clear that each line of the code is being interpreted as a new child process. I've been fiddling with it for a while and am currently at the banging-my-head-against-the-wall phase, because I'm sure there's something completely obvious that I'm missing. It seems like it should be straight forward.

caching hashrefs in state
4 direct replies — Read more / Contribute
by agname
on Apr 22, 2014 at 14:24
    Hi,

    I have been using state to cache a hashref and I am unsure whether this is good usage. It does however work.

    Here is an example of usage:

    #!/usr/bin/perl use v5.10; use strict; use warnings; sub example_sub { my $cfg = cfg_cache(); say $cfg->{x}; } sub cfg_cache { state $cfg = shift; return $cfg; } my $cfg = { x => "cat"}; cfg_cache($cfg); ## "cat" gets printed example_sub(); ## "mouse" gets printed. $cfg->{x} = "mouse"; example_sub(); ## but if I reset $cfg "mouse" still gets printed $cfg = { x => "rat"}; example_sub();

    example_sub() always gets whatever the current contents of $cfg should be as long as $cfg is not reset.

    Without reading from cfg_cache() example_sub() has no access to the $cfg hashref.

    The state perldoc says "variables will never be reinitialized" but it doesn't cover what happens if the variable is a reference.

    Is this good practice?

    I am using Perl 5.18 on Debian Unstable but using state this ways works from v5.10

text processing
4 direct replies — Read more / Contribute
by DAVERN
on Apr 22, 2014 at 13:10

    Beginner on PERL do not find the way to skip some lines (headers, table name) and do something else with the rest of the lines (print with some modifications), could someone help me?

    Data as follows

    TABLE NAME HEAD0 HEAD1 HEAD2 DATA00 DATA10 DATA20 DATA01 DATA11 DATA21 END

    i need the next result

    xxx=DATA00, xxx=DATA10, xxx=DATA20;

How to print a newline in oneliners ...
3 direct replies — Read more / Contribute
by karlgoethebier
on Apr 22, 2014 at 12:23

    Hi all, this one should be self explaining:

    karls-mac-mini:monks karl$ for i in {0..9}; do echo $i; done | perl -p +e '$_++' 12345678910karls-mac-mini:monks karl$

    Ok, but i want a newline:

    karls-mac-mini:monks karl$ for i in {0..9}; do echo $i; done | perl -n +e '$_++; print qq($_\n)' 1 2 3 4 5 6 7 8 9 10

    Quite simple. Got it. But sometimes i struggle a little bit with the essentials :-(

    So i wonder if there is a TMTOWTDI for doing something like this.

    Thank you very much for any hint and best regards, Karl

    «The Crux of the Biscuit is the Apostrophe»


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 examining the Monastery: (10)
    As of 2014-04-23 10:26 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      April first is:







      Results (541 votes), past polls