Sergio Escalada am Samstag, 2. Dezember 2006 15:41:
> Thanks for replies.
>
> The purpouse of this mini-script is to list the rows from a database loaded
> in memory ($ref_db is the reference to hashtable that cotains the DB). So I
> want to order the fields by different sort rules, and make the proccess as
> abstract as it's possible with a subrutine (sub cmpRule). This sub must
> recieve the rules (by array argument, for example), and create the body
> that will be called by sort.
You don't specify the exact requirements or data structures;
one way to do it in an abstract way is presented below.
I wrote this script from scratch; it *seems* to do what it should.
The idea is as follows:
1. According to perldoc -f sort, it's possible to give a code block
(delivering a subroutine reference) as argument to sort that does the
actual sort.
2. We don't code these different possible sorting subroutines explicitly,
since their number may be high (sort by one ore more fields, in
different order, ascending/descending, numeric/string sort
- in different combinations.
Instead, we code an "abstract" subroutine (sort_sub_factory)
that returns sorting subroutines created according to some rules.
The rules can be formulated in an easy way.
3. Every sorting routine craeated assumes the following data structure
of the db data (compare with the test data in the script):
$ref_db is a reference to an array (each array represents a database
record). The elements of the array contain hashrefs with
(fieldname, fieldvalue) pairs.
You can say for example: "Sort first by field2 (ascending, numerical sort),
then by field1 (descending, string sort)".
All combinations are possible.
You express above rules by
my @rules=( ['field2', 0, 0], ['field1, 1, 1] );
I hope this helps :-)
Dani
> This is what I've done since I wrote the message (now, it only works with
> one rule, but I think it's easy to do multiple-rules sort from here)
>
> The comparation subroutine:
>
> sub cmpRule
> {
> return '$$ref_db{$a}{$$ref_fields{$opt}[0]}'.
> ' cmp $$ref_db{$b}{$$ref_fields{$opt}[0]}';
> }
>
> ...#some code
>
> my $func = &cmpRule;
>
> foreach my $row (sort {eval($func)} keys %{$ref_db}){
> ...#some code
> }
>
>
> It works but, do you think it's a good solution?
>
> Thanks for your time.
>
> Sergio.
#!/usr/bin/perl
### THIS IS BETA SOFTWARE ###
use strict;
use warnings;
# @rules is a list of arrayrefs. Each array element contains the
# informations for one db field:
#
# [fieldname, desc_sort_bool, string_sort_bool].
# - sort descending if desc_sort_bool is true
# (else ascending)
# - sort via string comparison if string_sort_bool is true
# (else numerically)
#
# If @rules contains more than one element, the sorting is nested.
#
# ***BEWARE***: Sanitize all arguments before using in this sub!
#
sub sort_sub_factory {
my @[EMAIL PROTECTED];
my @sub_code_parts;
foreach my $rule (@rules) {
my ($field, $desc, $string)[EMAIL PROTECTED];
# handle boolean sort options
#
my $comp_op=$string ? 'cmp' : '<=>';
my ($a_var, $b_var)=$desc ? (qw/$b $a/) : (qw/$a $b/);
# create subroutine code parts
#
push @sub_code_parts,
'('.$a_var.'->{'.$field."} $comp_op ".$b_var.'->{'.$field."})\n";
}
# put all parts together, producing source code for sorting subroutine
#
my $sub_code="
sub {
return
@{[join ' || ', @sub_code_parts]}
}";
# just for debugging, output created source code:
#
warn "\n\n\nGenerated code:\n", $sub_code, "\n";
return eval $sub_code;
}
###
### TEST of above code
###
# helper sub to display sorted data
#
sub debug_print {
my ($title, $sorted_ref_db)[EMAIL PROTECTED];
print "$title:\n";
foreach my $record_hr (@$sorted_ref_db) {
print join ', ',
map {"$_ => $record_hr->{$_}"}
sort keys %$record_hr;
print "\n";
}
}
# our test data
#
my $ref_db=[
{f1=>'x', f2=>2, f3=>'Q'},
{f1=>'x', f2=>1, f3=>'A'},
{f1=>'x', f2=>2, f3=>'A'},
{f1=>'x', f2=>1, f3=>'Q'},
{f1=>'b', f2=>2, f3=>'Q'},
{f1=>'a', f2=>10,f3=>'A'},
{f1=>'a', f2=>40,f3=>'C'},
{f1=>'x', f2=>1, f3=>'X'},
];
# Several test sortings:
#
my ($title, $sort_sub);
$title ='by (f1, ascending, string comparison)';
$sort_sub=sort_sub_factory(['f1', 0, 1]);
debug_print ($title, [sort $sort_sub @$ref_db]);
$title ='by (f1, ascending, string comparison)' .
'(f2, ascending, numeric comparison)';
$sort_sub=sort_sub_factory(['f1', 0, 1], ['f2', 0, 0]);
debug_print ($title, [sort $sort_sub @$ref_db]);
$title ='by (f3, ascending, string comparison)' .
'(f2, descending, numeric comparison)';
$sort_sub=sort_sub_factory(['f3', 0, 1], ['f2', 1, 0]);
debug_print ($title, [sort $sort_sub @$ref_db]);
$title ='1st invalid request';
$sort_sub=sort_sub_factory(['f3', 1, 0]);
debug_print ($title, [sort $sort_sub @$ref_db]);
$title ='2nd invalid request';
{
local $SIG{__WARN__}=sub {print @_; die "INVALID sort sub '$title'!"};
$sort_sub=sort_sub_factory(['f3', 1, 0]);
};
debug_print ($title, [sort $sort_sub @$ref_db]);
__END__
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
