All:
I was inspired by this node to write my first serious module. There were two solutions already provided that didn't require wheel inventing, but I figured getting shredded by you fellow monks would be the best way to get better. I have no intentions of posting to CPAN even though this module does have some functionality the others do not. I would however like comments as though it were being posted. Please be brutal. I have already placed things down at the __end__ that I know are lacking and would love pointers on them as well.
package Seconds2English;
use strict;
use Carp;
our $VERSION = '0.01';
sub new {
my $class = shift;
croak "Improper option use" if (@_ % 2);
my %opts = @_;
my $self = bless {}, $class;
$self->_build(\%opts);
return $self;
}
sub _build {
my ($self, $opt_ref) = @_;
if (exists $opt_ref->{start}) {
my $secs = $opt_ref->{start};
$self->{time} = int(abs($secs)) if _is_number($secs);
delete $opt_ref->{start};
}
$self->{_croak} = sub {croak "$_[0] is not a valid option"};
$self->{time} = 0 unless (exists $self->{time});
@{$self->{_list}} = qw(years months weeks days hours minutes secon
+ds);
@{$self->{_table}}{@{$self->{_list}}} = (31536000, 2592000, 604800
+, 86400, 3600, 60, 1);
$self->_update_vals;
$self->_update_table($opt_ref) if (%{$opt_ref});
}
sub _is_number {
# From Scalar::Util
local $_ = shift;
return 0 unless defined;
return 1 if (/^[+-]?\d+$/);
return 1 if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/);
0;
}
sub _update_vals {
my ($self, $max) = @_;
my $seconds = exists $self->{time} ? $self->{time} : 0;
$self->{units} = ();
my ($key, @units) = $max ? ('_english', @{$max}) : ('english', @{$
+self->{_list}});
for my $unit (@units) {
if ($self->{_table}{$unit} > $seconds ) {
$self->{$unit} = 0;
next;
}
my $key = $max ? "_$unit" : $unit;
$self->{$key} = int($seconds / $self->{_table}{$unit});
push @{$self->{units}}, "$self->{$key} $unit";
chop ${$self->{units}}[-1] if ($self->{$key} < 2);
$seconds %= $self->{_table}{$unit};
}
unless (defined $self->{units}) {
$self->{$key} = '';
return;
}
if (@{$self->{units}} > 2) {
my $last = pop @{$self->{units}};
$self->{$key} = join ', ', @{$self->{units}}, "and $last";
}
elsif (@{$self->{units}} > 1) {
$self->{$key} = join ' and ' , @{$self->{units}};
}
elsif (@{$self->{units}} > 0) {
$self->{$key} = "${$self->{units}}[0]";
}
}
sub _update_table {
my ($self, $opt_ref) = @_;
while (my ($key, $val) = each %{$opt_ref}) {
unless ($key eq 'months' || $key eq 'years') {
$self->{_croak}($key);
}
if (_is_number($val)) {
$val = int(abs($val));
$self->{_table}{$key} = $val if ($val > 0);
}
}
$self->_update_vals;
}
sub seconds {return $_[0]->{seconds}}
sub minutes {return $_[0]->{minutes}}
sub hours {return $_[0]->{hours}}
sub days {return $_[0]->{days}}
sub weeks {return $_[0]->{weeks}}
sub months {return $_[0]->{months}}
sub years {return $_[0]->{years}}
sub english {return $_[0]->{english}}
sub time {return $_[0]->{time}}
sub in_seconds {return $_[0]->{time}}
sub in_minutes {return $_[0]->{time} / $_[0]->{_table}{minutes}}
sub in_hours {return $_[0]->{time} / $_[0]->{_table}{hours}}
sub in_days {return $_[0]->{time} / $_[0]->{_table}{days}}
sub in_weeks {return $_[0]->{time} / $_[0]->{_table}{weeks}}
sub in_months {return $_[0]->{time} / $_[0]->{_table}{months}}
sub in_years {return $_[0]->{time} / $_[0]->{_table}{years}}
sub english_max {
my ($self, $val) = @_;
$self->_custom_english('max', $val);
}
sub english_min {
my ($self, $val) = @_;
$self->_custom_english('min', $val);
}
sub _custom_english {
my ($self, $type, $val) = @_;
return $self->english unless $val;
for my $index (0 .. $#{$self->{_list}}) {
if ($val eq ${$self->{_list}}[$index]) {
my ($low, $high) = $type eq 'max' ? ($index, $#{$self->{_l
+ist}}): (0, $index);
$self->_update_vals([@{$self->{_list}}[$low .. $high]]);
return $self->{_english};
}
}
$self->{_croak}($val);
}
sub get {
my ($self, @subs) = @_;
my @values;
for my $sub (@subs) {
$self->{_croak}($sub) if ($sub =~ /^(_|get|new|set|modify)/);
eval {push @values, $self->$sub};
$self->{_croak}($sub) if $@;
}
return wantarray ? @values : \@values;
}
sub set {
my $self = shift;
croak "Improper option use" if (@_ % 2);
my %mods = @_;
while (my ($key, $val) = each %mods) {
if ($val =~ /^([-+])(.*)/) {
my ($op, $amount) = ($1, $2);
$self->{_croak}($amount) unless _is_number($amount);
unless (grep /\b$key\b/ , (@{$self->{_list}})) {
$self->{_croak}($key);
}
$amount *= $self->{_table}{$key};
$op eq '+' ? ($self->{time} += $amount) : ($self->{time} -
+= $amount);
}
else {
$self->{_croak}("$key => $val");
}
}
$self->{time} = int(abs($self->{time}));
$self->_update_vals;
}
sub modify_interval {
my $self = shift;
croak "Improper option use" if (@_ % 2);
my %opts = @_;
$self->_update_table(\%opts) if %opts;
}
1;
__END__
To Do
1. POD - it can't be that hard, see [id://252477] or [id://107642]
2. Tests - not sure what to test, you tried to break it as you wrote
+it
3. Comments! Stop thinking it is obvious, remember looking at it agai
+n 10 minutes later
4. Code a way to allow more user friendly options instead of just raw
+ seconds
5. Consider other time intervals - decades, centuries, etc?
Notes to self for later use in POD
1. Think up a good name
2. Caveats - seconds are truncated to nearest positive whole integer
+first
3. Compare this module to others that do similar things
4. Methods
A. new
my $obj = Seconds2English->new('start' => time);
my $obj = Seconds2English->new('start' => 144_000, 'months' =>
+ 60 * 60 * 24 * 31);
my $obj = Seconds2English->new('years' => 31556930);
B. years, months, weeks, days, hours, minutes, seconds
print $obj->hours, "\n"; # Returns number of hours currently
+stored in object
C. time
print $obj->time, "\n"; # Returns total number of seconds to
+create object
D. english
my $obj = Seconds2English->new('start' => 144_144);
print $obj->english, "\n"; # Returns user-friendly english str
+ing
# output = "1 day, 16 hours, 2 minutes, and 24 seconds"
E. in_years, in_months, in_weeks, in_days, in_hours, in_minutes,
+in_seconds
print $obj->in_months, "\n"; # Returns object time in just spe
+cified unit (integer)
F. english_max
my $obj = Seconds2English->new('start' => 144_144_144);
print $obj->english_max('weeks'), "\n"; # no interval above un
+it in output
# output = 238 weeks, 2 days, 8 hours, 2 minutes, and 24 secon
+ds
G. english_min
my $obj = Seconds2English->new('start' => 144_144_144);
print $obj->english_min('weeks'), "\n"; # no interval below un
+it in output
# output = 4 years, 6 months, and 4 weeks
H. get
my $obj = Seconds2English->new('start' => 144_144_144);
my ($years, $days, $minutes) = $obj->get('years', 'days', 'min
+utes');
my $array_ref = $obj->get('years', 'days', 'minutes');
I. set
my $obj = Seconds2English->new('start' => 456_789);
print $obj->english, "\n";
# ouput = 5 days, 6 hours, 53 minutes, and 9 seconds
$obj->set('days' => '-3', 'hours' => '+4', 'seconds' => '-8');
print $obj->english, "\n";
# ouput = 2 days, 10 hours, 53 minutes, and 1 second
J. modify_interval
my $obj = Seconds2English->new('start' => 144_144_144);
print $obj->english, "\n";
# output = 4 years, 6 months, 4 weeks, 8 hours, 2 minutes, and
+ 24 seconds
$obj->modify_interval('years' => 31556930, 'months' => 3155693
+0 / 12);
print $obj->english, "\n";
# output = 4 years, 6 months, 3 weeks, 3 days, 17 hours, 52 mi
+nutes, and 40 seconds
Again, this was a toy project to improve, so feel free to beat me about the head for anything you think could/should be better.
Cheers - L~R
(jeffa) Re: RFC: Seconds2English
by jeffa (Bishop) on Jul 18, 2003 at 21:19 UTC
|
Tests - not sure what to test, you tried to break it as you wrote it
Too bad you didn't "document" the process of breaking your
code ... you would have already finished that requirement.
* Tis better to write the test suite along side
the code instead of waiting until you are "finished". I sure
wish that i had ...
*of course, testing is never
finished
jeffa
L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)
| [reply] [d/l] |
|
| [reply] |
|
First off, read chromatic's
Introduction to Testing article at perl.com if
you already haven't.
You test your interface and make sure that you get the
expected results. Tests for the items that you mentioned
are 'user errors' ... you write validation code for that
instead. While i am sure that is possible to incorporate
such 'contracts' into a test suite ... i am not sure that
they belong there. Probably better is to pass some
function an argument that would cause an illegal division
by 0, and then test that the right error code or message
was returned instead.
jeffa
L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)
| [reply] |
Re: RFC: Seconds2English
by halley (Prior) on Jul 18, 2003 at 19:53 UTC
|
I did a *much* smaller version of this for an IRC trivia bot some time ago. When I get home this evening, I'll post it in the box below. "Humanizing" data is very important in user interfaces, and I'm tired of so many programs training users to be digital when a good program can train the computer to present things in analog.
# will update this box tonight
I assembled the elements like "4 minutes" in an array, and found truncating them to be useful for most human-scale messages. Most users don't care about the lesser-significant items. Thus, "4 years, 6 months, 3 weeks, 3 days, 17 hours, 52 minutes, and 40 seconds" would get chopped to two or three units, giving "4 years, and 6 months".
I was also working on a 'fuzzy' version which would give nice approximation according to the remainder: "nearly 4 years and 7 months".
-- [ e d @ h a l l e y . c c ] | [reply] [d/l] [select] |
|
| [reply] |
|
my %Times=(
1 => 'sec|second',
60 => 'min|minute',
60*60 => 'hour',
60*60*24 => 'day',
60*60*24*365 => 'year'
);
sub _dstr{
my ($mult,$mode,$unit)=@_;
my $str=$mult;
if ($mode!~/^[h#]/) {
my @names=split /\|/,$Times{$unit};
$str.=($mode eq 'l' ? " $names[-1]" : " $names[0]");
$str.="s" if $mult!=1;
} elsif ($mode eq 'h') {
$str.=substr($Times{$unit},0,1);
}
return $str
}
sub _duration {
my $mode=lc(shift); #
my $dur=shift;
$mode=~/^[hml#]$/ or $mode="m";
my $negative=$dur<0 ? ($mode eq "l" ? "negative " : $mode eq "m" ?
+ "neg " : "-")
: "";
my @units;
foreach my $unit (sort {$b <=> $a} keys %Times) {
next unless $unit>1;
if ($dur>=$unit) {
my $mult=int($dur/$unit);
$dur-=$mult*$unit;
push @units,_dstr $mult,$mode,$unit;
} elsif ($mode eq "#" and @units) {
push @units,0;
}
}
if ($dur or $mode eq "#" or not @units) {
push @units,_dstr $dur,$mode,1;
}
$units[-2].=" and ".pop @units
if @units>1 and $mode eq 'l';
return $mode ne "#" ? $negative.join( ", ",@units)
: $negative.sprintf(join(":",("%02d") x @units
+),@units);
}
Anyway, I figured this was similar to some of your stuff and you did mention being curious as to how others have done stuff....
---
demerphq
<Elian> And I do take a kind of perverse pleasure in having an OO assembly language...
| [reply] [d/l] [select] |
Re: RFC: Seconds2English
by lestrrat (Deacon) on Jul 18, 2003 at 20:07 UTC
|
| [reply] |
Re: RFC: Seconds2English
by Koschei (Monk) on Jul 22, 2003 at 01:39 UTC
|
| [reply] |
|
Koschei,
I am not sure how you are helping me here as I said I already knew about Time::Duration & Time::Seconds in the node I referenced. I know I am reinventing the wheel and I stated as much for the purpose of learning. My request was to tear this module apart. I stated that I had no intentions of uploading this module to CPAN even though it does have functionality that Time::Duration does not.
| [reply] |
|
Mostly, I was thinking: why does everyone want to reinvent wheels when learning? Why not find a wheel and augment it?
The process of augmentation will mean you have to understand the code and the rest of us get the benefit of an improved module.
You say your module has features above and beyond Time::Duration. So patch TD. I'm sure Sean would welcome your patch. Think of it as an exercise in community development.
As for the code: As belg says, look to something like Class::Accessor to obviate that nasty infection of identical accessors. I'd argue against using AUTOLOAD to create accessor. Something like chromatic's loop is much better. You seem to do a lot of calculation when anything is changed, rather than just when people want things. I'd like to comment more, but your main problems are in your todo list - items 1, 2 and 3. POD is well covered by perldoc perlpod. Tests, you've been given a pointer, and there's an excellent section in "Learning Perl Objects, References and Modules", merlyn's new book. Comments you just need to make the code clearer. It's hard to read with all the references you're using (and, as they're references, you can assign them to temporary variables which (as they're references) affect the original when you modify them). I can't quite see where you work out how long a month is (a fun thing since it varies according to when your period starts). As far as I can tell, it's one of those hard coded large numbers. (sidenote: 31_536_000 is valid perl: the underscores are ignored). You take _is_number from Scalar::Util. Why? It was happy there. You should access your internal bits via methods rather than direct hash access. Makes it easier when I want to write my subclass, and means you can stave off calculations until the methods are invoked, rather than needing calculation up front to make sure that the hash values are always right (well, until I reach in and modify one and they're all wrong).
The general thing is that when code is appropriately commented, documented and tested, if it does what it's meant to do, it's good. Just like the rest of cpan (ha!)
| [reply] |
|
|
Re: RFC: Seconds2English
by belg4mit (Prior) on Jul 18, 2003 at 19:58 UTC
|
| [reply] |
|
{
no strict 'refs';
for my $method (qw( seconds minutes hours days weeks months years
+))
{
*{ $method } = sub { return $_[0]->{ $method } };
*{ 'in_' . $method } = sub {
return $_[0]->{ time } / $_[0]->{_table }{ $method } }
+}
} }
Funny, that ended up quite a bit shorter than I expected. | [reply] [d/l] |
|
belg4mit,
I had considered AUTOLOAD for the trivial subs. I had also considered one of the modules that dynamically create your subs for you at compile time. I avoided both for the reason that if I decide to expand a single sub to do something unique, the dynamic code would get even more complicated.
L~R
| [reply] |
|
| [reply] |
|
|
|