Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

How to rewrite the following script without using the matching words using perl?

by finddata (Sexton)
on Mar 17, 2017 at 07:01 UTC ( #1184974=perlquestion: print w/replies, xml ) Need Help??

finddata has asked for the wisdom of the Perl Monks concerning the following question:

Input obtained by command click
NAME PRIO SUB PEND RUN LALLOT DESC adice_long 5 1137891 420 158 - ADICE Low-Priority/Long + Runtime Job Queue adice_ncsim 7 418075 11 102 IES:570 ADICE-Incisive Co-Simul +ation Queue adice_short 10 7472625 122 106 - ADICE High-Priority/Sho +rt Runtime Job Queue calibre 15 580 0 0 - Calibre DRC/LVS Queue dsp_ncsim_gls 10 46055 0 2 IES:570 PDSP: Incisive GLS Queu +e dsp_ncsim_hp 10 5245556 0 3 IES:570 PDSP: Incisive High-Pri +ority RTL Simulation Queue dsp_ncsim_lp 5 366785 0 0 IES:570 PDSP: Incisive Low-Prio +rity RTL Simulation Queue dsp_ncsim_mp 8 1636399 1596 146 IES:570 PDSP: Incisive Medium-P +riority RTL Simulation Q... hcg_ncsim_comp 10 73 0 0 - HCG: Incisive Compilati +on Queue hcg_ncsim_hp 10 3970481 1145 45 IES:570 HCG: Incisive High-Prio +rity Queue hcg_ncsim_lp 5 369 0 0 IES:570 HCG: Incisive Low-Prior +ity Queue hcg_ncsim_mp 8 860363 0 0 IES:570 HCG: Incisive Medium-Pr +iority Queue hcg_ncsim_short 10 81 0 0 IES:570 HCG: Incisive short run +time Queue ipdc_pte 8 19284 0 0 - PTE Job Queue ncsim_long 8 920692 145 103 IES:570 ASC: Incisive Medium Pr +iority/Long Queue ncsim_lp 5 779246 4 4 IES:570 ASC: Incisive Low Prior +ity Queue ncsim_short 10 4535468 1351 188 IES:570 ASC: Incisive High Prio +rity/Short Queue normal 7 3102627 123 4 - Default Queue spectreRF 12 107864 19 46 MMSIM:48 Spectre (APS/XPS/Spectr +eRF) Simulation Queue vcs 10 77382 0 0 VCS:0 VCS Simulation Queue
sub pend_status { my $str = shift; $DBH = &connect or die "Cannot connect to the sql server \n"; $DBH->do("USE $str;"); my $stmt="select distinct * from click;"; my $sth = $DBH->prepare( $stmt ); $sth->execute() or print "Could not insert data_rp"; while (my @columns = $sth->fetchrow_array() ) { if($columns[2] =~ /adice/i) { $pend_count{adice} +=$columns[4]; $run_count{adice} +=$columns[5]; } elsif($columns[2] =~ /calibre/i) { $pend_count{calibre} +=$columns[4]; $run_count{calibre} +=$columns[5]; } elsif($columns[2] =~ /vcs/i) { $pend_count{vcs} +=$columns[4]; $run_count{vcs} +=$columns[5]; } elsif($columns[2] =~ /spectre/i) { $pend_count{spectre} +=$columns[4]; $run_count{spectre} +=$columns[5]; } elsif($columns[2] =~ /Incisive/i) { $pend_count{incisive} +=$columns[4]; $run_count{incisive} +=$columns[5]; } else { $pend_count{others} +=$columns[4]; $run_count{others} +=$columns[5]; } } }
My query is instead of matching every word i should take by entire column it should match and print whatever matched.And the assignment calculation should be performed for every fourth and fifth column.

Replies are listed 'Best First'.
Re: How to rewrite the following script without using the matching words using perl?
by AnomalousMonk (Bishop) on Mar 17, 2017 at 08:49 UTC

    First, pay attention to the good advice of Corion.

    Second, here's some more untested code to consider. It's not a freebie: intentionally, it's convoluted and perhaps a bit over-engineered, so some thought will be required. It also doesn't work "without using the matching words" (assuming I understand what that means), but that's life.

    use constant TARGET_STRINGS => qw(adice calibre vcs spectre incisive); my ($target) = map qr{ (?i) (?: $_) }xms, join q{|}, map quotemeta, reverse sort TARGET_STRINGS ; ... my $hit = my ($capture) = $columns[2] =~ m{ $target }xmsg; for my $ar_update ( # ref. to hash source column # to update of update [ \%pend_count, 4 ], [ \%run_count, 5 ], ) { my ($hr_update, $col) = @$ar_update; $hr_update->{$hit ? lc($capture) : 'others'} += $columns[$col]; }


    Give a man a fish:  <%-{-{-{-<

Re: How to rewrite the following script without using the matching words using perl?
by Corion (Pope) on Mar 17, 2017 at 07:06 UTC

    Please post a working program shorter than 30 lines, and show us the output you get and where you fail to produce the correct output.

    Also tell us what is wrong with the current approach you have, and think about why your teacher or employer wants you to learn how to do it differently.

    A reply falls below the community's threshold of quality. You may see it by logging in.
Re: How to rewrite the following script without using the matching words using perl?
by huck (Parson) on Mar 17, 2017 at 08:16 UTC

    $columns[2]never has a word in it

    $columns[5]always has text in it

    Did you forget $columns[0]is the first column?

    sub pend_status { my $str = shift; my @tests=qw/adice calibre vcs spectre Incisive/; $DBH = &connect or die "Cannot connect to the sql server \n"; $DBH->do("USE $str;") or die "Cannot use $str\n"; my $stmt="select NAME,PRIO,SUB,PEND,RUN,LALLOT,DESC from click;"; my $sth = $DBH->prepare( $stmt )or die "Cannot prepare\n"; $sth->execute() or print "Could not select"; while (my @columns = $sth->fetchrow_array() ) { my $found='other'; for my $w(@tests) { if ($columns[0] =~ /$w/i){$found=$w; last; } } $pend_count{$found} +=$columns[3]; $run_count{$found} +=$columns[4]; } }
    Im not sure you want distinct either, that doesnt sum up like rows. Two rows could have the same values and you would want to add in both of them.

    and what happens to the var list of * if someone recreates the table with the fields in sorted order? has happened to me a few times already, dayum DBA's

Re: How to rewrite the following script without using the matching words using perl?
by Anonymous Monk on Mar 17, 2017 at 16:29 UTC
    Not sure what you mean by "take by entire column." Is this it?
    $pend_count{$columns[2]} += $columns[4]; $run_count{$columns[2]} += $columns[5];
    If that's the case, you might as well have the database do it.
    select name, sum(pend), sum(run) from click group by name

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1184974]
Approved by davido
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (4)
As of 2020-01-28 07:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?