Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

RFC: General Purpose Autosort Framework - going south...

by cmv (Chaplain)
on Jul 30, 2010 at 14:33 UTC ( #852095=perlmeditation: print w/ replies, xml ) Need Help??

Monks-

I started this adventure with a simple notion: having an autosort functionality (think Excel autofilter here) should be part of a common framework, similar to providing scrollbars in a GUI. I ended up treading down a path I'm not sure I want to be on, and questioning if a solution is feasable...

The code below is a prototype script for testing some ideas, and shows where I'm at now. It's a cute little script to play with, but has too many gotcha's for anything close to a common framework element. I'm hoping that it's just my implementation that's painted me into a corner, where I can see no way out.

In the most simple sense, it works. All of the fields get a sort button at the top, and pushing it will sort all the lines based on that column. The main problem is making it work as one would expect. You can see that I put some mild intelligence in there to define if a column to be sorted numerically vs alphabetically. That's one level up from basic functionality, but what about doing even better? How can I get it to handle complex field sets (like date and time in ls(1) output)? How can that even be specified?

Also, I'm wondering if I was just too devoted to my particular implementation. I initially liked the idea of using Sort::Fields to do the sorting, but as complexities were uncovered, I'm wondering if it would make more sense to re-implement the sorting by dicing up the lines into a data structure, and sorting that.

I'm hoping more agile minds here can redirect me to a path that has a solution. If you were to work this problem, how would you approach it? How should it be expected to work? Is this functionality worth a CPAN module? Does it already exist?

Comments & thoughts appreciated!

Thanks

-Craig

use strict; use warnings; use English; use Data::Dumper; use Tk; use Sort::Fields; # Globals... my %W; # Hash for widgets my $ACTIVESORT; # Currently active sort button # Set default command... my $CMD = 'ls -l'; if($OSNAME eq 'MSWin32') { $CMD = 'dir /-c /a-d' }; # Create the window... _createWin(); # Start the user off by doing the default command... _doCmd($CMD); # Go to event processing mode... MainLoop(); #################################################################### # Subroutine: _findFieldStarts (internal) # This routine requires all lines of input text to have the same # number of fields. It finds the leftmost initial character # position of each field, and indicates if the field is numeric # or not. # Arguments # $_[0] - Number of fields in all lines of text (mandatory) # $_[1] - Pointer to text list (mandatory) # Returns # List1: index - field number # contents - position of leftmost character # List2: index - field number # contents - field type ('n' if numeric) #################################################################### sub _findFieldStarts { my $fields = shift || die "Missing fields per line"; my $txtp = shift || die "Missing Text Pointer"; # Initialize @starts to be max display width (in chars)... my @starts = (100) x $fields; # Initialize @types to be all numeric... my @types = ('n') x $fields; foreach my $line (@{$txtp}) { # Split on ' ' (not \s+) for initial spaces in field 1 # see http://www.perlmonks.org/?node_id=850448 my @words = split(' ', $line); my $start=0; # map returns list of starting positions for given line... my %h = map { my $i = index($line, $_, $start); # start pos my $l = length($_); # length $start = $i + $l; # next start my $number = 'n'; if($_=~/\s*\D+\s*/){$number=''}; $i, $number; } @words; # Sort hash keys to get starting positions in order... my @s = sort {$a<=>$b} keys(%h); # See if current line will change @starts or @types... foreach my $i (0..$fields-1) { # Keep leftmost (lowest numbered) positions... if( $starts[$i] > $s[$i] ) { $starts[$i] = $s[$i]; } # Any non-numerical chars negates numerical sort... if($h{$s[$i]} ne 'n') { $types[$i] = $h{$s[$i]}; } } # Force first field to start at char=0 (if there is initial # whitespace, it won't want to start there)... $starts[0] = 0; } return(\@starts, \@types); } #################################################################### # Subroutine: _groupByFields (internal) # This routine groups the given text by fields/line. This is # so we can pick one set of fields to autosort on. # Arguments # $_[0] - Pointer to list of text (mandatory) # Returns # Hash pointer: index - fields/line # contents - All lines with $index fields #################################################################### sub _groupByFields { my $txtp = shift || die "Missing Text Pointer"; my %grouped; # Txt grouped by number of fields/line foreach my $line ( @{$txtp} ) { no warnings; # http://www.perlmonks.org/?node_id=313616 # Split on ' ' (not /s+) for initial spaces in field 1: # http://www.perlmonks.org/?node_id=850448 my $f = scalar(split(' ', $line)) || next; use warnings; # Group line with others having same number of fields... push(@{$grouped{$f}}, $line); } return(\%grouped); } #################################################################### # Subroutine: _doCmd (internal) # This routine executes the provided command, figures out what # subset of text to use, and supplies it to the GUI routines. # Arguments # $_[0] - Text of command to run (Mandatory) # Returns # None #################################################################### sub _doCmd { my $cmd = shift || die "Missing command"; # Run command to get data... my @out = split(/\n/, `$cmd`); chomp(@out); if(!scalar(@out)) { die "Bad command response: $cmd\n", Dumper(\@out), "\n"; } # Remove "bad" things (hoo-boy this is a hack)... if($OSNAME eq 'MSWin32') { # WINDOWS: Remove all non-file entry lines... @out = grep !/^ /, @out; }else{ # UNIX: Remove initial "total" line... if( $out[0] =~/^total \d+$/ ) { shift(@out) }; } # Group text by the number of fields-per-line... my $fGroups_p = _groupByFields(\@out); # Find the most popular fieldsize in this data... my ($maxLines, $maxFields) = (0, 0); foreach my $g (keys(%{$fGroups_p})) { my $lines = scalar(@{$fGroups_p->{$g}}); if($maxLines < $lines) { ($maxFields, $maxLines) = ($g, $lines); } } print STDERR "Autosplitting lines with $maxFields fields only.\n"; # Find the starting character positions and type for each field... my ($fstart_p, $ftype_p) = _findFieldStarts($maxFields,$fGroups_p->{$maxFields}); # Put data into GUI... _guiData($fGroups_p->{$maxFields}, $fstart_p, $ftype_p); return(); } #################################################################### # Subroutine: _createWin (internal) # This routine sets up the GUI # Arguments # None # Returns # Pointer to MainWindow #################################################################### sub _createWin { # Check if window already exists... if(defined($W{Top})) { # Might want to raise the window to the top here... warn "\aERROR - Window Already Exists\n"; return; } # Create new text window... my $top = MainWindow->new(); $W{Top} = $top; $top->title("Autosort of ls(1) Output"); $top->minsize(600,300); $top->protocol('WM_DELETE_WINDOW', sub{exit}); # Setup to destroy global widgets upon destruction... $top->OnDestroy(sub{undef $top;}); # Define an up arrow... my $arrowUpBits = pack("b8" x 5, "........", "...11...", "..1111..", ".111111.", "........"); # Define a down arrow... my $arrowDnBits = pack("b8" x 5, "........", ".111111.", "..1111..", "...11...", "........"); # Define an idle arrow... my $arrowIdleBits = pack("b8" x 5, "........", "...11...", "..1111..", "...11...", "........"); # Create the bitmaps... $top->DefineBitmap('arrowUp' => 8, 5, $arrowUpBits); $top->DefineBitmap('arrowDn' => 8, 5, $arrowDnBits); $top->DefineBitmap('arrowIdle' => 8, 5, $arrowIdleBits); # Put a button frame in first, to hold the sort buttons on top... $W{BFrame} = $top->Frame()->pack(-anchor=>'w', -fill=>'x'); # Put in a do-nothing button, just for initial setup & sizing... push( @{$W{SortButtons}}, $W{BFrame}->Button(-bitmap=>'arrowIdle', -state=>'disabled')->pack(-side=>'left') ); # Put in the files text box second... $W{File} = $top->Scrolled('Text', -height=>4, -state=>'disabled', -scrollbars=>'osoe')-> pack(-expand=>1, -fill=>'both'); # Put in a frame below the text box... $W{CmdF} = $top->Frame()->pack(-fill=>'x'); # Add label, entry, & button... $W{CmdF}->Label(-text=>'Command:')->pack(-side=>'left'); $W{CmdEnt} = $W{CmdF}->Entry(-relief=>'sunken', -textvariable=>\$CMD)-> pack(-side=>'left', -expand=>1, -fill=>'x'); $W{CmdBut} = $W{CmdF}->Button(-text=>'run', -command=>sub{ _doCmd($CMD); })->pack(-side=>'left'); return($top); } #################################################################### # Subroutine: _guiData (internal) # This routine puts the text into the GUI & adds autosort buttons # Arguments # $_[0] - Pointer to text list (mandatory) # $_[1] - Pointer to list of field starting positions # $_[2] - Pointer to list of field types # Returns # None #################################################################### sub _guiData { my $txt_p = shift || die "Missing Text Pointer"; my $fstart_p = shift || die "Missing field starts"; my $ftype_p = shift || die "Missing field types"; # Put the text up into the GUI $W{File}->configure(-state=>'normal'); $W{File}->Contents( join("\n", @$txt_p) ); $W{File}->configure(-state=>'disabled'); $W{File}->update; # for bbox below # map transforms character start positions into pixels... my @starts = map { # The first element bbox returned list is start pos... ($W{File}->bbox("1.$_"))[0]; # pixel conversion } @{$fstart_p}; # Remove any existing buttons... my $b; while ( $b = pop(@{$W{SortButtons}}) ) { $b->destroy; undef($ACTIVESORT); } # Put up the new buttons... foreach my $b (0..(scalar(@$fstart_p)-1)) { # ending pixel (next start - fudge, or end of line)... my $w; if($starts[$b+1]) { $w = ($starts[$b+1] - 8) - $starts[$b]; } _addButton($txt_p, \$b, $ftype_p->[$b], $w,); } } #################################################################### # Subroutine: _addButton (internal) # This routine puts a sort button in the GUI. Note, use pointer # for $_[1] so zero value won't fire "die". # Arguments # $_[0] - Pointer to text list (mandatory) # $_[1] - Pointer to field number to sort on (mandatory) # $_[2] - Field type (optional) # $_[3] - Width of button (optional) # Returns # None #################################################################### sub _addButton { my $txt_p = shift || die "Missing text pointer"; my $fp = shift || die "Missing field number pointer"; my $ft = shift; my $width = shift; # Create $f for fieldsort below (bump up list index, add type)... my $f = ($$fp + 1) . $ft; # Put a button in the button frame... $W{SortButtons}[$$fp] = $W{BFrame}->Button( -command=>sub{ # Turn of any highlighted sort button... if ( (defined($ACTIVESORT)) && ($$fp != $ACTIVESORT) ) { $W{SortButtons}[$ACTIVESORT]->configure( -bitmap=>'arrowIdle'); } # Make this button the active one... $ACTIVESORT = $$fp; # Setup toggling of the button (up->down, down->up)... my $next; my $current = $W{SortButtons}[$$fp]->cget('-bitmap'); if($current eq 'arrowUp') { $next = 'arrowDn' } elsif($current eq 'arrowDn') { $next = 'arrowUp' } elsif($current eq 'arrowIdle') { $next = 'arrowDn' } else { die "Invalid Arrow Value: current=$current\n" }; # Toggle the button... $W{SortButtons}[$$fp]->configure(-bitmap=>$next); # Get fieldsort to work with initial spaces in field 1: # http://www.perlmonks.org/?node_id=850501 my @sorted = fieldsort( "".qr/(?<!^)(?<!\s)\s+/, [$f], @$txt_p); if($next eq 'arrowUp') { @sorted = reverse(@sorted) }; $W{File}->configure(-state=>'normal'); $W{File}->Contents( join("\n", @sorted) ); $W{File}->configure(-state=>'disabled'); }, -bitmap=>'arrowIdle' ); # Expand the last button only... if(defined($width)) { $W{SortButtons}[$$fp]->configure(-width=>$width); $W{SortButtons}[$$fp]->pack(-side=>'left'); }else{ $W{SortButtons}[$$fp]-> pack(-side=>'left', -expand=>1, -fill=>'x'); } }

Comment on RFC: General Purpose Autosort Framework - going south...
Download Code
Re: RFC: General Purpose Autosort Framework - going south...
by SuicideJunkie (Priest) on Jul 30, 2010 at 16:32 UTC

    As for the input rows, I would expect the caller to have a far superior ability to split out the columns. Taking in an array for each row rather than a string makes more sense to me.

    Passing in a two dimensional array to fill the whole chart at once would also be a common use case I think.


    Have you considered taking in an array of sub refs to use as the sorting algorithm for each corresponding field?

    You could then either apply the arbitrary algorithm associated with the column being sorted, or if the ref is undef, then make a best guess.


    PS: It might be a nice feature to make each cell be a reference to the original input data so that an external change will be reflected in the table automatically on the next repaint, without having to pass everything in again from scratch and rebuild the table.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://852095]
Front-paged by Arunbear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (13)
As of 2014-12-19 13:07 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (82 votes), past polls