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'); } }
In reply to RFC: General Purpose Autosort Framework - going south... by cmv
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |