Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine

RFC: Seconds2English

by Limbic~Region (Chancellor)
on Jul 18, 2003 at 19:37 UTC ( #275722=perlmeditation: print w/replies, xml ) Need Help??

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

Replies are listed 'Best First'.
(jeffa) Re: RFC: Seconds2English
by jeffa (Bishop) on Jul 18, 2003 at 21:19 UTC

    From your __END__ block:

    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


    (the triplet paradiddle with high-hat)
      Ok - for example:
    • Ensuring that there was an even numbered list if assigning to a hash
    • Ensuring that division by 0 would not happen
    • Ensuring that a variable looked like a number before performing a numerical operation on it
    • Ensuring that if someone passes a bad option to the get routine it gets trapped in an eval

      These are the types of things that I did - how would I incorporate them into a test. I was under the impression that tests were designed to make sure your code works the same on someone else's platform and version of Perl as you coded it???

      Cheers and thanks - L~R

        First off, read chromatic's Introduction to Testing article at 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.


        (the triplet paradiddle with high-hat)
Re: RFC: Seconds2English
by lestrrat (Deacon) on Jul 18, 2003 at 20:07 UTC
Re: RFC: Seconds2English
by Koschei (Monk) on Jul 22, 2003 at 01:39 UTC
    Mmm. Time::Duration
      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.

        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!)

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 ]

      The english_min() method would do the truncation you mentioned, but there is no 'fuzzy' version. There was a point where I just needed to stop giving it bloat since my intention wasn't to upload it to CPAN.

      I will be interested to see how your code looks. I dreamed my code up before peaking at the other similar modules as to not be influenced.

      Cheers - L~R

        This is from Text::XSprintf that I've had to put on the back burner. The $mode and stuff is for that module, and the sub below _duration is meant to be called by autogenerated code....

        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....


        <Elian> And I do take a kind of perverse pleasure in having an OO assembly language...
Re: RFC: Seconds2English
by belg4mit (Prior) on Jul 18, 2003 at 19:58 UTC
    Given the brevity of many of your accessors I'd consider using AUTOLOAD and try to return the attribute of the same name as the sub that was called, if it exists.

    I'm not belgian but I play one on TV.

      Why get that complex? I'd rather:

      { 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.

      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.


        If you expand the sub to do anything other than return a key you implement it as a named sub. FIN.

        I'm not belgian but I play one on TV.

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://275722]
Approved by Enlil
Front-paged by sauoq
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (4)
As of 2021-10-18 19:48 GMT
Find Nodes?
    Voting Booth?
    My first memorable Perl project was:

    Results (75 votes). Check out past polls.