Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Re^2: How to add columns with new row name using perl from mysql query?

by perlanswers (Initiate)
on Apr 05, 2017 at 06:52 UTC ( #1187070=note: print w/replies, xml ) Need Help??


in reply to Re: How to add columns with new row name using perl from mysql query?
in thread How to add columns with new row name using perl from mysql query?

I have few doubts .Here you had used the queue_name and filtered with the first 5.
In case if i want to filter by their values with jobs_running instead of considering queue_name .
Obatined output:
+---------------+--------------+--------------+ | queue_name | jobs_pend | jobs_run | +---------------+--------------+--------------+ | adice_long | 5 | 39 | | adice_ncsim | 0 | 6 | | adice_short | 254 | 192 | | calibre | 0 | 0 | | dsp_ncsim_gls | 0 | 2 | +---------------+--------------+--------------+
Expected output:
+---------------+--------------+--------------+ | queue_name | jobs_pend | jobs_run | +---------------+--------------+--------------+ | adice_short | 254 | 192 | | adice_long | 5 | 39 | | adice_ncsim | 0 | 6 | | calibre | 0 | 0 | | dsp_ncsim_gls | 0 | 2 | | others | 212 | 218 | +---------------+--------------+--------------+

So i had tried with revamping the mysql query for the code which you had posted which as follows.But i couldnt get the expected output
use DBI; use strict; my $DBH = get_dbh(); my $sql = 'SELECT queue_name,jobs_pend,jobs_run FROM queues order by jobs_run DESC'; my $sth = $DBH->prepare( $sql ); $sth->execute(); # input my %table = (); my $recno = 0; while (my ($name,$pend,$run) = $sth->fetchrow_array){ my $key = ($recno++ < 5) ? $name : 'other' ; $table{$key}{'pend'} += $pend; $table{$key}{'run'} += $run; } # output for my $key (sort keys %table){ my @col = ($key);# col[0] $col[1] = $table{$key}{'pend'}; $col[2] = $table{$key}{'run'}; printf "| %-25s | %3d | %3d |\n",@col; }

Replies are listed 'Best First'.
Re^3: How to add columns with new row name using perl from mysql query?
by poj (Abbot) on Apr 05, 2017 at 07:12 UTC

    The hash won't preserve the sort order from the SQL so you have to retain that in an array which I have called @top

    #!perl use DBI; use strict; my $DBH = get_dbh(); my $sql = 'SELECT queue_name,jobs_pend,jobs_run FROM queues ORDER BY jobs_run DESC'; my $sth = $DBH->prepare( $sql ); $sth->execute(); # input my %table = (); my $recno = 0; my @top = (); while (my ($name,$pend,$run) = $sth->fetchrow_array){ my $key = ($recno++ < 5) ? $name : 'other' ; $table{$key}{'pend'} += $pend; $table{$key}{'run'} += $run; push @top,$key unless ($top[-1] eq 'other'); } # output for my $key (@top){ my @col = ($key);# col[0] $col[1] = $table{$key}{'pend'}; $col[2] = $table{$key}{'run'}; printf "| %-25s | %3d | %3d |\n",@col; }

    Update : you could just use an array without the hash

    # input my @top = (); my $max = 5; my $recno = 0; while (my ($name,$pend,$run) = $sth->fetchrow_array){ my $ix = ($recno > $max) ? $max : $recno ; $top[$ix][0] = $name; $top[$ix][1] += $pend; $top[$ix][2] += $run; ++$recno; } $top[$max][0] = 'other'; # output for (@top){ printf "| %-25s | %3d | %3d |\n",@$_; }
    poj
      i had tried to print the output block in the perl cgi format which as follows.But nothing is printed for me.Let me know what mistake i had done in the following?
      print "var data_run=[$row_array{$key}{'pend'}];\n"; print "var data_pend=[$row_array{$key}{'run'}];\n";

      For my previous code which i used for questioning there i had printed which as follows.Here it works fine.which as follows
      print "var data_running = [$var_data_running]; \n"; print "var data_pending = [$var_data_pending]; \n"; <br> Here the if and else statements variables are printed outside in perl +cgi format<br> <c> while(my @row_array=$sth->fetchrow_array) { if ($tmp == 0) { $var_data_running .= "\[\"$row_array[0] \($row_array[2]\)\",$r +ow_array[2]\]"; $var_data_pending .= "\[\"$row_array[0] \($row_array[1]\)\",$r +ow_array[1]\]"; $tmp++; } else { $var_data_running .= ",\[\"$row_array[0] \($row_array[2]\)\",$ +row_array[2]\]"; $var_data_pending .= ",\[\"$row_array[0] \($row_array[1]\)\",$ +row_array[1]\]"; } }
      </c>
      Likewise the above if and else statement variables i had tried to print the same varibales for the code which you mentioned but i had failes in those cases.
      Thanks for any help.

        poj replied to perlanswers you've responded as finddata. Did you forget which account you were logged in with?

        To format the data for javascript use the JSON module

        #!perl use strict; use warnings; use JSON 'encode_json'; my @top = ( ["adice_short", 254, 192], ["ncsim_short", 0, 84], ["ncsim_long", 41, 78], ["adice_long", 5, 39], ["normal", 170, 30], ["other", 1, 34], ); my @pend=(); my @run =(); for (@top){ push @pend,["$_->[0] ($_->[1])",$_->[1]]; push @run, ["$_->[0] ($_->[2])",$_->[2]]; } my $json_data_pend = encode_json( \@pend ); my $json_data_run = encode_json( \@run ); print "var data_run = $json_data_run \n";
        poj

        back to your pie charts now huh?

        It might help if you understood what your var data_run= statment was supposed to look like. If i remember correctly it is an array of arrays. The interior arrays contain a label and a value.

        var data_run=[ ["label a",1],["label b",2],["label_c",99]];
        use strict; use warnings; use DBI; my $storagefile='finddata'; my $DBH = DBI->connect( "dbi:SQLite:dbname=".$storagefile ) || die "Ca +nnot connect: $storagefile $DBI::errstr"; my $sql = 'SELECT queue_name,jobs_pend,jobs_run FROM queues ORDER BY jobs_run DESC'; my $sth = $DBH->prepare( $sql ); $sth->execute(); # input my %table = (); my $recno = 0; my @top = (); while (my ($name,$pend,$run) = $sth->fetchrow_array){ my $key = ($recno++ < 5) ? $name : 'other' ; push @top,$key unless (defined ($top[-1]) && $top[-1] eq 'other'); $table{$key}{'pend'} += $pend; $table{$key}{'run'} += $run; } #So first you need to make your interior arrays my @iarray_run; for my $key (@top){ push @iarray_run,'["'.$key.'",'.$table{$key}{'run'}.']'; } # then you join them and assign them my $orun=join(',',@iarray_run); print "var data_run=[$orun];\n";
        Result
        var data_run=[["adice_short",192],["ncsim_short",84],["ncsim_long",78] +,["adice_long",39],["normal",30],["other",34]];
        They must be hard up for programmers where you work. It takes you days to produce something that anyone competent would do in an hour.

Re^3: How to add columns with new row name using perl from mysql query?
by huck (Parson) on Apr 05, 2017 at 08:10 UTC

    Gee thats funny. Given

    use strict; use warnings; use DBD::SQLite; use DBI; my $table='queues'; my $ccode='queue_name TEXT, jobs_pend INTEGER, jobs_run INTEGER'; my $storagefile='finddata'; my $dbh = DBI->connect( "dbi:SQLite:dbname=".$storagefile ) || die "Ca +nnot connect: $storagefile $DBI::errstr"; remake($table,$ccode); my $insert; { my $sql='INSERT INTO '.$table.'( queue_name , jobs_pend , jobs_run ) +values( ?,?,?)'; $insert=$dbh->prepare($sql); } while (my $line=<DATA>) { $line=~s/ //g; my (undef,$qn,$jp,$jr)=split('[|]',$line); $insert->execute($qn,$jp,$jr); } my $select; { my $sql="select * from ".$table; $select=$dbh->prepare($sql); } $select->execute(); while(my $row=$select->fetchrow_arrayref){ printf "| %-25s | %3d | %3d |\n",@$row; # print join ('|',@$row)."\n"; } # ROW $select->finish; exit; sub remake { my $table=shift; my $code=shift; $table='queues' unless ($table); $code='queue_name TEXT, jobs_pend INTEGER, jobs_run INTEGER' unless + ($code); $dbh->do("DROP TABLE IF EXISTS ".$table); my $sql="CREATE TABLE ".$table.' ('.$code.')'; print $sql."\n"; $dbh->do($sql); } # redo; exit; __DATA__ | adice_long | 5 | 39 | | adice_ncsim | 0 | 6 | | adice_short | 254 | 192 | | calibre | 0 | 0 | | dsp_ncsim_gls | 0 | 2 | | dsp_ncsim_hp | 0 | 2 | | dsp_ncsim_lp | 0 | 5 | | dsp_ncsim_mp | 0 | 5 | | hcg_ncsim_comp | 0 | 0 | | hcg_ncsim_hp | 0 | 9 | | hcg_ncsim_lp | 0 | 0 | | hcg_ncsim_mp | 0 | 0 | | hcg_ncsim_short | 0 | 0 | | ipdc_pte | 0 | 0 | | ncsim_long | 41 | 78 | | ncsim_lp | 1 | 4 | | ncsim_short | 0 | 84 | | normal | 170 | 30 | | spectreRF | 0 | 1 | | vcs | 0 | 0 |
    when i run
    use strict; use warnings; use DBI; my $storagefile='finddata'; my $DBH = DBI->connect( "dbi:SQLite:dbname=".$storagefile ) || die "Ca +nnot connect: $storagefile $DBI::errstr"; my $sql = 'SELECT queue_name,jobs_pend,jobs_run FROM queues order by jobs_run DESC'; my $sth = $DBH->prepare( $sql ); $sth->execute(); # input my %table = (); my $recno = 0; while (my ($name,$pend,$run) = $sth->fetchrow_array){ my $key = ($recno++ < 5) ? $name : 'other' ; $table{$key}{'pend'} += $pend; $table{$key}{'run'} += $run; } # output for my $key (sort keys %table){ my @col = ($key);# col[0] $col[1] = $table{$key}{'pend'}; $col[2] = $table{$key}{'run'}; printf "| %-25s | %3d | %3d |\n",@col; }
    i get
    | adice_long | 5 | 39 | | adice_short | 254 | 192 | | ncsim_long | 41 | 78 | | ncsim_short | 0 | 84 | | normal | 170 | 30 | | other | 1 | 34 |
    See i got an other row that you said you didnt, and i displayed rows correctly that you didnt. Why didnt you post what you actually got? Are you that lazy? If you dont want to help us why should we help you? You dont even grovel correctly.

    and of course poj is right about the sort order. in  sort keys %table adice_long comes before adice_short

    You owe the PerlOracle a remote job entry queue (

    )

Re^3: How to add columns with new row name using perl from mysql query?
by Anonymous Monk on Apr 05, 2017 at 10:37 UTC

    There are two fast ordered-hash implementationson on CPAN: Hash::Ordered and MCE::Shared::Ordhash.

    use strict; use warnings; use Hash::Ordered; use Data::Dumper; tie my %table, 'Hash::Ordered'; for my $key (qw( a_a b_b c_c d_d e_e )) { $table{$key}{'pend'} += 1; $table{$key}{'run'} += 2; } print Dumper(\%table), "\n";

    The following does the same thing via MCE::Shared::Ordhash (non-shared construction via Tie).

    use strict; use warnings; use MCE::Shared::Ordhash; use Data::Dumper; tie my %table, 'MCE::Shared::Ordhash'; for my $key (qw( a_a b_b c_c d_d e_e )) { $table{$key}{'pend'} += 1; $table{$key}{'run'} += 2; } print Dumper(\%table), "\n";

    Both produce the following output. Notice how the first level keys have retained order.

    $VAR1 = { 'a_a' => { 'run' => 2, 'pend' => 1 }, 'b_b' => { 'pend' => 1, 'run' => 2 }, 'c_c' => { 'run' => 2, 'pend' => 1 }, 'd_d' => { 'run' => 2, 'pend' => 1 }, 'e_e' => { 'run' => 2, 'pend' => 1 } };

    These modules are reasonably fast. The OO interface is faster when extra performance is desired. However, the TIE interface is nice when wanting the native hash look and feel. There's no reason why one cannot have both. MCE::Shared::Ordhash, via the overload mechanism, handles on-demand hash-dereferencing on the fly.

    use strict; use warnings; use MCE::Shared::Ordhash; use Data::Dumper; my $table = MCE::Shared::Ordhash->new(); for my $key (qw( a_a b_b c_c d_d e_e )) { $table->{$key}{'pend'} += 1; $table->{$key}{'run'} += 2; } print Dumper($table), "\n";

    The table hash is the real MCE::Shared::Ordhash object and not something hidden behind the TIE interface. Therefore, a dump of it will give you the structure of the object.

    $VAR1 = bless( [ { 'a_a' => { 'run' => 2, 'pend' => 1 }, 'b_b' => { 'pend' => 1, 'run' => 2 }, 'd_d' => { 'run' => 2, 'pend' => 1 }, 'c_c' => { 'pend' => 1, 'run' => 2 }, 'e_e' => { 'pend' => 1, 'run' => 2 } }, [ 'a_a', 'b_b', 'c_c', 'd_d', 'e_e' ], {}, \0, \0, { 'a_a' => $VAR1->[0]{'a_a'}, 'b_b' => $VAR1->[0]{'b_b'}, 'c_c' => $VAR1->[0]{'c_c'}, 'd_d' => $VAR1->[0]{'d_d'}, 'e_e' => $VAR1->[0]{'e_e'} } ], 'MCE::Shared::Ordhash' );

    If you have time, check them out. Do random deletes or anything pertaining to a hash. You will be pleased with the performance. In that case, one might find the following useful.

    use strict; use warnings; use Hash::Ordered; use MCE::Shared::Ordhash; use List::Util 'shuffle'; use Time::HiRes 'time'; my ($start, $total); srand 0; sub ready { my $time = time; $total += $time - $start; $start = $time; } # my $oh = Hash::Ordered->new(); my $oh = MCE::Shared::Ordhash->new(); print ref($oh), "\n"; my @keys1 = shuffle('aaaa'..'gggf'); # size: 109,674 my @keys2 = shuffle('gggg'..'mmmm'); # size: 109,675 my @keys3 = shuffle('nnnn'..'ttts'); # size: 109,674 my @keys4 = shuffle('tttt'..'zzzz'); # size: 109,675 $oh->set($_,$_) for ('a'..'m','_','n'..'z'); # add 26 or more keys $oh->delete('_'); # has INDX afterwards $start = time; $oh->set($_,$_) for @keys1; printf "duration (set ): %0.02f\n", time - $start; ready(); $oh->push($_,$_) for @keys2; printf "duration (push ): %0.02f\n", time - $start; ready(); $oh->unshift($_,$_) for @keys3; printf "duration (unshift): %0.02f\n", time - $start; ready(); $oh->merge(map {$_,$_} @keys4); printf "duration (merge ): %0.02f\n", time - $start; # ready(); # $oh->delete($_) for @keys2; # printf "duration (delete ): %0.02f\n", time - $start; printf "total time : %0.02f\n", $total += time - $start;

    Results vary from system to system. The following were captured from a 2.6 GHz machine. Anyway, these are the fastest pure-Perl ordered-hash implementations on CPAN right now. The results show the time taken to complete each action. Thus, lower is faster.

    Hash::Ordered duration (set ): 0.20 duration (push ): 0.24 duration (unshift): 0.29 duration (merge ): 0.23 total time : 0.95 MCE::Shared::Ordhash duration (set ): 0.12 duration (push ): 0.16 duration (unshift): 0.21 duration (merge ): 0.15 total time : 0.65

    MCE::Shared::Ordhash has low overhead. The reason is that the internal INDX hash is populated only on-demand. There are no worries about delays, for example deleting keys. Compare these with Tie::IxHash. Do forward and reverse deletes. Not to forget random deletes.

    Perl is fun.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (3)
As of 2020-10-27 12:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My favourite web site is:












    Results (256 votes). Check out past polls.

    Notices?