http://www.perlmonks.org?node_id=1056831

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

Good Evening Monks. I would like to post multiple rows using the following code however only one line is posted when selected any suggestions? Thanks in advance.

#!/usr/bin/perl use Tk; my $window = MainWindow->new; $window->title("Host Report"); ($labs = $window->Label(-text => "Results"))->pack(-side => 'bottom'); $window->Entry(-textvariable => \$hdb )->pack; $window->Button(-text => "Go", -command => \&host )->pack; $window->Button(-text => "Quit", -command => \&stop )->pack; MainLoop; sub host { open (FH,"hostdata.txt"); my @lines = <FH>; close FH; foreach my $hdb2 (@lines) { my @field = split(':',$hdb2); if ($field[0] =~ /(?<![\w-])$hdb(?![\w-])/i) { $labs->configure(-text =>"$field[0] $field[1] $field[2]"); } } } sub stop{ exit; }

Replies are listed 'Best First'.
Re: Multiple Rows
by mtmcc (Hermit) on Oct 04, 2013 at 07:10 UTC
    First, it's worth using strict and warnings.

    Second, when you configure the text of the label in a loop, you literally do just that, ie you set the text of the label to the current value you assign to it.

    If you want a multiline label, I'd join the individual lines together into a single string before printing it, like this:

    #!/usr/bin/perl use Tk; use strict; use warnings; my $window = MainWindow->new; $window -> geometry("100x200"); $window->title("Host Report"); my $labs = $window->Label(-text => "Results", -wraplength => 100)->pac +k(-side => 'bottom'); #$window->Entry(-textvariable => \$hdb )->pack; $window->Button(-text => "Go", -command => \&host )->pack; $window->Button(-text => "Quit", -command => \&stop )->pack; MainLoop; sub host { my @message; #open (FH,"host.txt"); my @lines = <DATA>; #close FH; foreach my $hdb2 (@lines) { my @field = split(':',$hdb2); #if ($field[0] =~ /(?<![\w-])$hdb(?![\w-])/i) { push (@message, "$field[0] $field[1] $field[2]"); #} } my $messageString = join ('', @message); $labs->configure(-text =>"$messageString"); } sub stop{ exit; } __DATA__ these: lines are: the: lines that: you are: looking: at

    Alternatively, you could use a widget other than a label, maybe something like this:

    !/usr/bin/perl use strict; use warnings; use Tk; use Tk::ROText; my $hdb; my $window = MainWindow->new; $window->title("Host Report"); my $labs = $window->Scrolled('ROText')->pack(-side => 'bottom'); $labs -> Insert ("Results\n\n"); $window->Entry(-textvariable => \$hdb )->pack; $window->Button(-text => "Go", -command => \&host )->pack; $window->Button(-text => "Quit", -command => \&stop )->pack; MainLoop; sub host { #open (FH, "<", "host.txt"); my @lines = <DATA>; print STDERR "@lines\n\n"; #close FH; foreach my $hdb2 (@lines) { my @field = split(':',$hdb2); #if ($field[0] =~ /(?<![\w-])$hdb(?![\w-])/i) { $labs->Insert("$field[0] $field[1] $field[2]"); #} } } sub stop{ exit; } __DATA__ these: lines are: the: lines that: you are: looking: at

    I hope that's helpful

      Both Options worked perfectly thanks!

      What format method would you suggest mtmcc to line up the rows? Thanks.

        I'm glad you've made some progress.

        I'm not certain what you mean by lining up the rows; if you mean aligning the columns, then you could do something like use a table widget, instead of a label/ROText, like this:

        #!/usr/bin/perl use strict; use warnings; use Tk; use Tk::ROText; use Tk::Table; my $hdb; my $window = MainWindow->new; $window->title("Host Report"); my $labs = $window->Table(-columns => 3, -rows => 5)->pack(-side => 'b +ottom'); $labs -> put (1, 1, "Results"); $window->Entry(-textvariable => \$hdb )->pack; $window->Button(-text => "Go", -command => \&host )->pack; $window->Button(-text => "Quit", -command => \&stop )->pack; MainLoop; sub host { #open (FH, "<", "host.txt"); my $row = 2; my $col = 0; my $x = 0; my @lines = <DATA>; print STDERR "@lines\n\n"; #close FH; foreach my $hdb2 (@lines) { chomp $hdb2; my @field = split(':',$hdb2); #if ($field[0] =~ /(?<![\w-])$hdb(?![\w-])/i) { for ($x=0; $x <=2; $x += 1) { $field[$x] = '' unless defined $field[$x]; my $tempLabel = $labs->Label(-text =>"$field[$x]", -anchor => +'w'); $labs->put($row, $x, $tempLabel); } $row += 1; #} } } sub stop{ exit; } __DATA__ these:lines are:the:lines that:you are:looking:at

        Alternatively, you could get all the data you want to print in an array or other data structure, and use a text based approach to alignment (eg see 'padding with spaces' here: Using (s)printf())

        If you meant something else, let me know and I'll try again...

Re: Multiple Rows
by aaron_baugher (Curate) on Oct 04, 2013 at 04:34 UTC

    I get the error message: "Variable length lookbehind not implemented in regex". What is it you want the regex to do? Maybe there's a different way to do it.

    Also, you should "use strict; use warnings;" and indentation is good for the soul. And here's a more perlish way to process a file line-by line without loading it all into memory first, using the safer three-argument open with error-checking:

    open my $fh, '<', 'hostdata.txt' or die $!; while( my $hdb2 = <$fh> ){ # do stuff with $hdb2 } close $fh;

    Aaron B.
    Available for small or large Perl jobs; see my home node.

Re: Multiple Rows in Tk::Label
by Anonymous Monk on Oct 04, 2013 at 04:31 UTC

    You need to ddumperBasic debugging checklist the data you're using, it probably doesn't have newlines

    #!/usr/bin/perl -- use strict; use warnings; use Tk; my $mw = tkinit(); my $l = $mw->Label->pack( -side => 'bottom' ); $mw->Button( -command => [ \&ralala, $l ], )->pack; MainLoop(); sub ralala { my( $l ) = @_; $l->configure( -text => join "\n", 1 .. rand 4 ); }