Here's my implementation. Documentation will come in a while, and I haven't tested it (I just wrote it, and I'm in the mood for dinner), but here's the code:
package Set::Range;
$VERSION = '1.0j'; # j for japhy ;)
sub new {
my $class = shift;
my $self = bless {
CACHE => {},
RANGE => [],
}, $class;
while (my ($k,$v) = splice(@_, 0, 2)) {
my ($low, $high) = split /\s*(?:,|\.{2,})\s*/, $k;
unless ($high) {
$high = substr($low, 1);
chop $low;
}
my $li = (substr($low, 0, 1, '') eq '[');
my $hi = (substr($high, 0, 1, '') eq ']');
my $l = $self->fmt($low);
my $h = $self->fmt($high);
$self->{CACHE}{$l} = $v if $li;
$self->{CACHE}{$h} = $v if $hi;
push @{ $self->{RANGE} }, {
LO => $l,
HI => $h,
LO_INC => $li,
HI_INC => $hi,
VALUE => $v,
CODE =>
($l == $h && sub { $l == $_[0] })
||
($li && $hi && sub { ($l ne '' && $l <= $_[0]) and ($h ne '' &
+& $_[0] <= $h) } )
||
($li && sub { ($l ne '' && $l <= $_[0]) and ($h ne '' && $_[0]
+ < $h) } )
||
($hi && sub { ($l ne '' && $l < $_[0]) and ($h ne '' && $_[0]
+<= $h) } )
||
sub { ($l ne '' && $l < $_[0]) and ($h ne '' && $_[0] < $h) }
};
}
return $self;
}
sub range {
my ($self, $value) = @_;
$value = $self->fmt($value);
return $self->{CACHE}{$value} if exists $self->{CACHE}{$value};
$_->{CODE}->($value) and return($self->{CACHE}{$value} = $_->{VALUE}
+)
for @{ $self->{RANGE} };
return;
}
package Set::Range::Date;
@ISA = qw( Set::Range );
sub fmt {
my $d = pop;
return sprintf "%04d%02d%02d",
($d =~ /(\d{1,2})\D*(\d{1,2})\D*(\d+)/)[2,1,0];
}
package Set::Range::Date::Eu;
@ISA = qw( Set::Range );
sub fmt {
my $d = pop;
return sprintf "%04d%02d%02d",
($d =~ /(\d{1,2})\D*(\d{1,2})\D*(\d+)/)[2,0,1];
}
package Set::Range::Time;
@ISA = qw( Set::Range );
sub fmt {
my $t = pop;
# assume it's a timestamp
return $t unless $t =~ /\D/;
# does it look a like 12-hour clock?
if ($t =~ /([apAP])/) {
my $is_pm = (lc($1) ne 'a');
my @parts = $t =~ /(\d+)/g;
$parts[0] %= 12;
$parts[0] += 12 if $is_pm;
return sprintf '%02d' x 4, @parts;
}
# otherwise, assume 24-hour clock
return sprintf '%02d' x 4, $t =~ /(\d+)/g;
}
package Set::Range::Number;
@ISA = qw( Set::Range );
sub fmt { pop }
1;
__END__
Sample use is:
use Set::Range;
my $r = Set::Range::Date->new(
'[1/1/2001,12/31/2001]' => "",
'[,1/1/2001)' => "before ",
'(12/31/2001,]' => "after ",
);
print "Today is ", $r->range('5/6/2000'), "now";
Mine uses standard set notation (a bracket means inclusive, and a parenthesis means exclusive) as the key, and some value (such as a code reference) for the value. The sets should be sent in a meaningful order -- the order they'll be tested in.
I also use OO design to specify the formatting as a sub-class action, and leave the actual comparing up to the main class.
This isn't meant to be a challenge or whatever to your module, it's just how I would write the thing. Yours looks rather nice (save that eval(), which you tell me you've gotten rid of in your CPAN'd version).
japhy --
Perl and Regex Hacker | [reply]
[d/l]
[select] |
This isn't meant to be a challenge or whatever to your module, it's just how I would write the thing. Yours looks rather nice (save that eval(), which you tell me you've gotten rid of in your CPAN'd version).
Absolutely no offense taken - I'm not into the whole ego thing, I think this is the whole point of open source: It's really nice to see how this can be developed into a useful module that people can use. Coming from a mainly Windows background this is a new experience for me - I like it. Anyway, I did ask for comments\revisions etc.
Simon
$code or die
$ perldoc perldoc
| [reply] |
use Set::Range;
my %set= ('1' => { lower => 0,
upper => 10,
upper_inclusive => 1,
},
'2' => { lower => 11,
upper => 100,
lower_inclusive => 1,
},
);
my $range=Set::Range->new(\%set);
print $range->getState('19', NUM_RANGE);
# prints "2"
my %set= ('Jan' => { lower => '1/1/2001',
upper => '1/31/2001',
upper_inclusive => 1,
lower_inclusive => 1,
}, # Days in January
'Feb' => { lower => '2/1/2001',
upper => '2/28/2001',
upper_inclusive => 1,
lower_inclusive => 1,
}, # Days in February
);
my $range=Set::Range->new(\%set);
print $range->getSet('1/11/2001', DATE_RANGE);
# prints "Jan"
Set::Range allows you to define ranges of numeric or date values and will
return the set that a given test value lies in. This module removes the
need for multiple if .. elsif .. (etc) tests and lets you modify the sets
on the fly without having to recode the logic in your scripts.
E.g.: define date ranges and test for which set '1/1/2002' is in.
- new
-
This creates the Set::Range Object
Example:
my $range = Set::Range->new(\%sets);
Pass new() a reference to a Hash containing the set
information.
- %sets
-
The hash defining the sets contains one hash per set
with at least 'upper' and 'lower' defined.
'upper_inclusive' and 'lower_inclusive' are optional
and are the equivalent of >= and <= for the upper and
lower set boundries.
The set hash can look like this:
{
'key1' => {
lower => 0,
upper => 10
},
'key2' => {
lower => 10,
upper => 15,
lower_inclusive => 1,
},
'key3' => {
lower => 15
upper => 25,
lower_inclusive => 1,
upper_inclusive => 1,
},
}
etc... The lower and upper values can either be
numeric values or date values in the form
mm/dd/yyyy or dd/mm/yyyy (see C<getSet> for
Euro-formatted dates)
- getSet
-
getSet() returns the value of the set that the test item is a member of.
Optionally accepts one of the following contants (defaults to numeric):
NUM_RANGE, DATE_RANGE, EU_DATE_RANGE, TIME_RANGE(same as NUM_RANGE)
Examples:
my $set = $range->getSet(10);
my $set = $range->getSet('1/14/2002', DATE_RANGE);
getSet returns 0 if the test value was not found to be a member of any
set.
Note: Set::Range uses Date::Calc functions to convert the date to
a datestamp. I settled on Date::Calc because Time::Local doesn't
support years > 2038.
NUM_RANGE, DATE_RANGE, EU_DATE_RANGE, TIME_RANGE constants
| [reply]
[d/l]
[select] |