From 4c09622b4432820e49795345a747e530e5aa0764 Mon Sep 17 00:00:00 2001 From: Byron Jones Date: Tue, 29 Oct 2013 13:32:25 +0800 Subject: Bug 892615: Add a 24 hour nag to all requests (review, feedback and need-info) and make them follow-able --- extensions/RequestNagger/Extension.pm | 250 +++++++++++++++++++++ extensions/RequestNagger/bin/send-request.nags.pl | 183 +++++++++++++++ extensions/RequestNagger/lib/Constants.pm | 111 +++++++++ extensions/RequestNagger/lib/TimeAgo.pm | 186 +++++++++++++++ .../account/prefs/request_nagging.html.tmpl | 56 +++++ .../request_nagging-requestee-header.txt.tmpl | 19 ++ .../email/request_nagging-requestee.html.tmpl | 91 ++++++++ .../email/request_nagging-requestee.txt.tmpl | 45 ++++ .../email/request_nagging-watching-header.txt.tmpl | 15 ++ .../email/request_nagging-watching.html.tmpl | 105 +++++++++ .../email/request_nagging-watching.txt.tmpl | 47 ++++ .../hook/account/prefs/prefs-tabs.html.tmpl | 14 ++ .../hook/admin/products/edit-common-rows.html.tmpl | 16 ++ .../hook/admin/products/updated-changes.html.tmpl | 14 ++ .../en/default/hook/bug/show-header-end.html.tmpl | 9 + .../hook/global/setting-descs-settings.none.tmpl | 11 + .../hook/global/user-error-errors.html.tmpl | 25 +++ .../en/default/pages/request_defer.html.tmpl | 101 +++++++++ extensions/RequestNagger/web/js/requestnagger.js | 13 ++ .../RequestNagger/web/style/requestnagger.css | 42 ++++ extensions/RequestWhiner/disabled | 0 21 files changed, 1353 insertions(+) create mode 100644 extensions/RequestNagger/bin/send-request.nags.pl create mode 100644 extensions/RequestNagger/lib/Constants.pm create mode 100644 extensions/RequestNagger/lib/TimeAgo.pm create mode 100644 extensions/RequestNagger/template/en/default/account/prefs/request_nagging.html.tmpl create mode 100644 extensions/RequestNagger/template/en/default/email/request_nagging-requestee-header.txt.tmpl create mode 100644 extensions/RequestNagger/template/en/default/email/request_nagging-requestee.html.tmpl create mode 100644 extensions/RequestNagger/template/en/default/email/request_nagging-requestee.txt.tmpl create mode 100644 extensions/RequestNagger/template/en/default/email/request_nagging-watching-header.txt.tmpl create mode 100644 extensions/RequestNagger/template/en/default/email/request_nagging-watching.html.tmpl create mode 100644 extensions/RequestNagger/template/en/default/email/request_nagging-watching.txt.tmpl create mode 100644 extensions/RequestNagger/template/en/default/hook/account/prefs/prefs-tabs.html.tmpl create mode 100644 extensions/RequestNagger/template/en/default/hook/admin/products/edit-common-rows.html.tmpl create mode 100644 extensions/RequestNagger/template/en/default/hook/admin/products/updated-changes.html.tmpl create mode 100644 extensions/RequestNagger/template/en/default/hook/bug/show-header-end.html.tmpl create mode 100644 extensions/RequestNagger/template/en/default/hook/global/setting-descs-settings.none.tmpl create mode 100644 extensions/RequestNagger/template/en/default/hook/global/user-error-errors.html.tmpl create mode 100644 extensions/RequestNagger/template/en/default/pages/request_defer.html.tmpl create mode 100644 extensions/RequestNagger/web/js/requestnagger.js create mode 100644 extensions/RequestNagger/web/style/requestnagger.css create mode 100644 extensions/RequestWhiner/disabled (limited to 'extensions') diff --git a/extensions/RequestNagger/Extension.pm b/extensions/RequestNagger/Extension.pm index a8dc4a5c2..af9eb1783 100644 --- a/extensions/RequestNagger/Extension.pm +++ b/extensions/RequestNagger/Extension.pm @@ -13,9 +13,244 @@ use warnings; use base qw(Bugzilla::Extension); use Bugzilla::Constants; +use Bugzilla::Error; +use Bugzilla::Extension::RequestNagger::TimeAgo qw(time_ago); +use Bugzilla::Flag; +use Bugzilla::Install::Filesystem; +use Bugzilla::User::Setting; +use Bugzilla::Util qw(datetime_from detaint_natural); +use DateTime; our $VERSION = '1'; +BEGIN { + *Bugzilla::Flag::age = \&_flag_age; + *Bugzilla::Flag::deferred = \&_flag_deferred; + *Bugzilla::Product::nag_interval = \&_product_nag_interval; +} + +sub _flag_age { + return time_ago(datetime_from($_[0]->modification_date)); +} + +sub _flag_deferred { + my ($self) = @_; + if (!exists $self->{deferred}) { + my $dbh = Bugzilla->dbh; + my ($defer_until) = $dbh->selectrow_array( + "SELECT defer_until FROM nag_defer WHERE flag_id=?", + undef, + $self->id + ); + $self->{deferred} = $defer_until ? datetime_from($defer_until) : undef; + } + return $self->{deferred}; +} + +sub _product_nag_interval { $_[0]->{nag_interval} } + +sub object_columns { + my ($self, $args) = @_; + my ($class, $columns) = @$args{qw(class columns)}; + if ($class->isa('Bugzilla::Product')) { + push @$columns, 'nag_interval'; + } +} + +sub object_update_columns { + my ($self, $args) = @_; + my ($object, $columns) = @$args{qw(object columns)}; + if ($object->isa('Bugzilla::Product')) { + push @$columns, 'nag_interval'; + } +} + +sub object_before_create { + my ($self, $args) = @_; + my ($class, $params) = @$args{qw(class params)}; + return unless $class->isa('Bugzilla::Product'); + my $interval = _check_nag_interval(Bugzilla->cgi->param('nag_interval')); + $params->{nag_interval} = $interval; +} + +sub object_end_of_set_all { + my ($self, $args) = @_; + my ($object, $params) = @$args{qw(object params)}; + return unless $object->isa('Bugzilla::Product'); + my $interval = _check_nag_interval(Bugzilla->cgi->param('nag_interval')); + $object->set('nag_interval', $interval); +} + +sub _check_nag_interval { + my ($value) = @_; + detaint_natural($value) + || ThrowUserError('invalid_parameter', { name => 'request reminding interval', err => 'must be numeric' }); + return $value < 0 ? 0 : $value * 24; +} + +sub page_before_template { + my ($self, $args) = @_; + my ($vars, $page) = @$args{qw(vars page_id)}; + return unless $page eq 'request_defer.html'; + + my $user = Bugzilla->login(LOGIN_REQUIRED); + my $input = Bugzilla->input_params; + + # load flag + my $flag_id = scalar($input->{flag}) + || ThrowUserError('request_nagging_flag_invalid'); + detaint_natural($flag_id) + || ThrowUserError('request_nagging_flag_invalid'); + my $flag = Bugzilla::Flag->new({ id => $flag_id, cache => 1 }) + || ThrowUserError('request_nagging_flag_invalid'); + + # you can only defer flags directed at you + $user->can_see_bug($flag->bug->id) + || ThrowUserError("bug_access_denied", { bug_id => $flag->bug->id }); + $flag->status eq '?' + || ThrowUserError('request_nagging_flag_set'); + $flag->requestee + || ThrowUserError('request_nagging_flag_wind'); + $flag->requestee->id == $user->id + || ThrowUserError('request_nagging_flag_not_owned'); + + my $date = DateTime->now()->truncate(to => 'day'); + my $defer_until; + if ($input->{'defer-until'} + && $input->{'defer-until'} =~ /^(\d\d\d\d)-(\d\d)-(\d\d)$/) + { + $defer_until = DateTime->new(year => $1, month => $2, day => $3); + if ($defer_until > $date->clone->add(days => 7)) { + $defer_until = undef; + } + } + + if ($input->{save} && $defer_until) { + $self->_defer_until($flag_id, $defer_until); + $vars->{saved} = "1"; + $vars->{defer_until} = $defer_until; + } + else { + my @dates; + foreach my $i (1..7) { + $date->add(days => 1); + unshift @dates, { days => $i, date => $date->clone }; + } + $vars->{defer_until} = \@dates; + } + + $vars->{flag} = $flag; +} + +sub _defer_until { + my ($self, $flag_id, $defer_until) = @_; + my $dbh = Bugzilla->dbh; + + $dbh->bz_start_transaction(); + + my ($defer_id) = $dbh->selectrow_array("SELECT id FROM nag_defer WHERE flag_id=?", undef, $flag_id); + if ($defer_id) { + $dbh->do("UPDATE nag_defer SET defer_until=? WHERE id=?", undef, $defer_until->ymd, $flag_id); + } else { + $dbh->do("INSERT INTO nag_defer(flag_id, defer_until) VALUES (?, ?)", undef, $flag_id, $defer_until->ymd); + } + + $dbh->bz_commit_transaction(); +} + +# +# hooks +# + +sub object_end_of_update { + my ($self, $args) = @_; + if ($args->{object}->isa("Bugzilla::Flag") && exists $args->{changes}) { + # any change to the flag (setting, clearing, or retargetting) will clear the deferals + my $flag = $args->{object}; + Bugzilla->dbh->do("DELETE FROM nag_defer WHERE flag_id=?", undef, $flag->id); + } +} + +sub user_preferences { + my ($self, $args) = @_; + my $tab = $args->{'current_tab'}; + return unless $tab eq 'request_nagging'; + + my $save = $args->{'save_changes'}; + my $vars = $args->{'vars'}; + my $user = Bugzilla->user; + my $dbh = Bugzilla->dbh; + + my %watching = + map { $_ => 1 } + @{ $dbh->selectcol_arrayref( + "SELECT profiles.login_name + FROM nag_watch + INNER JOIN profiles ON nag_watch.nagged_id = profiles.userid + WHERE nag_watch.watcher_id = ? + ORDER BY profiles.login_name", + undef, + $user->id + ) }; + + if ($save) { + my $input = Bugzilla->input_params; + Bugzilla::User::match_field({ 'add_watching' => {'type' => 'multi'} }); + + $dbh->bz_start_transaction(); + + # user preference + if (my $value = $input->{request_nagging}) { + my $settings = $user->settings; + my $setting = new Bugzilla::User::Setting('request_nagging'); + if ($value eq 'default') { + $settings->{request_nagging}->reset_to_default; + } + else { + $setting->validate_value($value); + $settings->{request_nagging}->set($value); + } + } + + # watching + if ($input->{remove_watched_users}) { + my $del_watching = ref($input->{del_watching}) ? $input->{del_watching} : [ $input->{del_watching} ]; + foreach my $login (@$del_watching) { + my $u = Bugzilla::User->new({ name => $login, cache => 1 }) + || next; + next unless exists $watching{$u->login}; + $dbh->do( + "DELETE FROM nag_watch WHERE watcher_id=? AND nagged_id=?", + undef, + $user->id, $u->id + ); + delete $watching{$u->login}; + } + } + if ($input->{add_watching}) { + my $add_watching = ref($input->{add_watching}) ? $input->{add_watching} : [ $input->{add_watching} ]; + foreach my $login (@$add_watching) { + my $u = Bugzilla::User->new({ name => $login, cache => 1 }) + || next; + next if exists $watching{$u->login}; + $dbh->do( + "INSERT INTO nag_watch(watcher_id, nagged_id) VALUES(?, ?)", + undef, + $user->id, $u->id + ); + $watching{$u->login} = 1; + } + } + + $dbh->bz_commit_transaction(); + } + + $vars->{watching} = [ sort keys %watching ]; + + my $handled = $args->{'handled'}; + $$handled = 1; +} + # # installation # @@ -90,4 +325,19 @@ sub install_update_db { $dbh->bz_add_column('products', 'nag_interval', { TYPE => 'INT2', NOTNULL => 1, DEFAULT => 7 * 24 }); } +sub install_filesystem { + my ($self, $args) = @_; + my $files = $args->{'files'}; + my $extensions_dir = bz_locations()->{'extensionsdir'}; + my $script_name = $extensions_dir . "/" . __PACKAGE__->NAME . "/bin/send-request-nags.pl"; + $files->{$script_name} = { + perms => Bugzilla::Install::Filesystem::WS_EXECUTE + }; +} + +sub install_before_final_checks { + my ($self, $args) = @_; + add_setting('request_nagging', ['on', 'off'], 'on'); +} + __PACKAGE__->NAME; diff --git a/extensions/RequestNagger/bin/send-request.nags.pl b/extensions/RequestNagger/bin/send-request.nags.pl new file mode 100644 index 000000000..c62d91f03 --- /dev/null +++ b/extensions/RequestNagger/bin/send-request.nags.pl @@ -0,0 +1,183 @@ +#!/usr/bin/perl + +# This Source Code Form is subject to the terms of the Mozilla Public +# License, v. 2.0. If a copy of the MPL was not distributed with this +# file, You can obtain one at http://mozilla.org/MPL/2.0/. +# +# This Source Code Form is "Incompatible With Secondary Licenses", as +# defined by the Mozilla Public License, v. 2.0. + +use strict; +use warnings; + +use FindBin qw($RealBin); +use lib "$RealBin/../../.."; + +use Bugzilla; +BEGIN { Bugzilla->extensions() } + +use Bugzilla::Attachment; +use Bugzilla::Bug; +use Bugzilla::Constants; +use Bugzilla::Error; +use Bugzilla::Extension::RequestNagger::Constants; +use Bugzilla::Mailer; +use Bugzilla::User; +use Bugzilla::Util qw(format_time); +use Email::MIME; +use Sys::Hostname; + +Bugzilla->usage_mode(USAGE_MODE_CMDLINE); + +my $DO_NOT_NAG = grep { $_ eq '-d' } @ARGV; + +my $dbh = Bugzilla->dbh; +my $date = $dbh->selectrow_array('SELECT LOCALTIMESTAMP(0)'); +$date = format_time($date, '%a, %d %b %Y %T %z', 'UTC'); + +# delete expired defers +$dbh->do("DELETE FROM nag_defer WHERE defer_until <= CURRENT_DATE()"); +Bugzilla->switch_to_shadow_db(); + +# send nags to requestees +send_nags( + sql => REQUESTEE_NAG_SQL, + template => 'requestee', + recipient_field => 'requestee_id', + date => $date, +); + +# send nags to watchers +send_nags( + sql => WATCHING_NAG_SQL, + template => 'watching', + recipient_field => 'watcher_id', + date => $date, +); + +sub send_nags { + my (%args) = @_; + my $rows = $dbh->selectall_arrayref($args{sql}, { Slice => {} }); + + # iterate over rows, sending email when the current recipient changes + my $requests = []; + my $current_recipient; + foreach my $request (@$rows) { + # send previous user's requests + if (!$current_recipient || $request->{$args{recipient_field}} != $current_recipient->id) { + send_email(%args, recipient => $current_recipient, requests => $requests); + $current_recipient = Bugzilla::User->new({ id => $request->{$args{recipient_field}}, cache => 1 }); + $requests = []; + } + + # check group membership + $request->{requestee} = Bugzilla::User->new({ id => $request->{requestee_id}, cache => 1 }); + my $group; + foreach my $type (FLAG_TYPES) { + next unless $type->{type} eq $request->{flag_type}; + $group = $type->{group}; + last; + } + next unless $request->{requestee}->in_group($group); + + # check bug visibility + next unless $current_recipient->can_see_bug($request->{bug_id}); + + # create objects + $request->{bug} = Bugzilla::Bug->new({ id => $request->{bug_id}, cache => 1 }); + $request->{requester} = Bugzilla::User->new({ id => $request->{requester_id}, cache => 1 }); + $request->{flag} = Bugzilla::Flag->new({ id => $request->{flag_id}, cache => 1 }); + if ($request->{attach_id}) { + $request->{attachment} = Bugzilla::Attachment->new({ id => $request->{attach_id}, cache => 1 }); + # check attachment visibility + next if $request->{attachment}->isprivate && !$current_recipient->is_insider; + } + if (exists $request->{watcher_id}) { + $request->{watcher} = Bugzilla::User->new({ id => $request->{watcher_id}, cache => 1 }); + } + + # add this request to the current user's list + push(@$requests, $request); + } + send_email(%args, recipient => $current_recipient, requests => $requests); +} + +sub send_email { + my (%vars) = @_; + my $vars = \%vars; + return unless $vars->{recipient} && @{ $vars->{requests} }; + + # restructure the list to group by requestee then flag type + my $request_list = delete $vars->{requests}; + my $requests = {}; + my %seen_types; + foreach my $request (@{ $request_list }) { + # by requestee + my $requestee_login = $request->{requestee}->login; + $requests->{$requestee_login} ||= { + requestee => $request->{requestee}, + types => {}, + typelist => [], + }; + + # by flag type + my $types = $requests->{$requestee_login}->{types}; + my $flag_type = $request->{flag_type}; + $types->{$flag_type} ||= []; + + push @{ $types->{$flag_type} }, $request; + $seen_types{$requestee_login}{$flag_type} = 1; + } + foreach my $requestee_login (keys %seen_types) { + my @flag_types; + foreach my $flag_type (map { $_->{type} } FLAG_TYPES) { + push @flag_types, $flag_type if $seen_types{$requestee_login}{$flag_type}; + } + $requests->{$requestee_login}->{typelist} = \@flag_types; + } + $vars->{requests} = $requests; + + # generate email + my $template = Bugzilla->template_inner($vars->{recipient}->setting('lang')); + my $template_file = $vars->{template}; + + my ($header, $text); + $template->process("email/request_nagging-$template_file-header.txt.tmpl", $vars, \$header) + || ThrowTemplateError($template->error()); + $header .= "\n"; + $template->process("email/request_nagging-$template_file.txt.tmpl", $vars, \$text) + || ThrowTemplateError($template->error()); + + my @parts = ( + Email::MIME->create( + attributes => { content_type => "text/plain" }, + body => $text, + ) + ); + if ($vars->{recipient}->setting('email_format') eq 'html') { + my $html; + $template->process("email/request_nagging-$template_file.html.tmpl", $vars, \$html) + || ThrowTemplateError($template->error()); + push @parts, Email::MIME->create( + attributes => { content_type => "text/html" }, + body => $html, + ); + } + + my $email = Email::MIME->new($header); + $email->header_set('X-Generated-By' => hostname()); + if (scalar(@parts) == 1) { + $email->content_type_set($parts[0]->content_type); + } else { + $email->content_type_set('multipart/alternative'); + } + $email->parts_set(\@parts); + + # send + if ($DO_NOT_NAG) { + print $email->as_string, "\n"; + } else { + MessageToMTA($email); + } +} + diff --git a/extensions/RequestNagger/lib/Constants.pm b/extensions/RequestNagger/lib/Constants.pm new file mode 100644 index 000000000..ff31b94e0 --- /dev/null +++ b/extensions/RequestNagger/lib/Constants.pm @@ -0,0 +1,111 @@ +# This Source Code Form is subject to the terms of the Mozilla Public +# License, v. 2.0. If a copy of the MPL was not distributed with this +# file, You can obtain one at http://mozilla.org/MPL/2.0/. +# +# This Source Code Form is "Incompatible With Secondary Licenses", as +# defined by the Mozilla Public License, v. 2.0. + +package Bugzilla::Extension::RequestNagger::Constants; + +use strict; +use base qw(Exporter); + +our @EXPORT = qw( + FLAG_TYPES + REQUESTEE_NAG_SQL + WATCHING_NAG_SQL +); + +# the order of this array determines the order used in email +use constant FLAG_TYPES => ( + { + type => 'review', # flag_type.name + group => 'everyone', # the user must be a member of this group to receive reminders + }, + { + type => 'feedback', + group => 'everyone', + }, + { + type => 'needinfo', + group => 'editbugs', + }, +); + +sub REQUESTEE_NAG_SQL { + my $dbh = Bugzilla->dbh; + my @flag_types_sql = map { $dbh->quote($_->{type}) } FLAG_TYPES; + + return " + SELECT + flagtypes.name AS flag_type, + flags.id AS flag_id, + flags.bug_id, + flags.attach_id, + flags.modification_date, + requester.userid AS requester_id, + requestee.userid AS requestee_id + FROM + flags + INNER JOIN flagtypes ON flagtypes.id = flags.type_id + INNER JOIN profiles AS requester ON requester.userid = flags.setter_id + INNER JOIN profiles AS requestee ON requestee.userid = flags.requestee_id + INNER JOIN bugs ON bugs.bug_id = flags.bug_id + INNER JOIN products ON products.id = bugs.product_id + LEFT JOIN attachments ON attachments.attach_id = flags.attach_id + LEFT JOIN profile_setting ON profile_setting.setting_name = 'request_nagging' + LEFT JOIN nag_defer ON nag_defer.flag_id = flags.id + WHERE + " . $dbh->sql_in('flagtypes.name', \@flag_types_sql) . " + AND flags.status = '?' + AND products.nag_interval != 0 + AND TIMESTAMPDIFF(HOUR, flags.modification_date, CURRENT_DATE()) >= products.nag_interval + AND (profile_setting.setting_value IS NULL OR profile_setting.setting_value = 'on') + AND requestee.disable_mail = 0 + AND nag_defer.id IS NULL + ORDER BY + flags.requestee_id, + flagtypes.name, + flags.modification_date + "; +} + +sub WATCHING_NAG_SQL { + my $dbh = Bugzilla->dbh; + my @flag_types_sql = map { $dbh->quote($_->{type}) } FLAG_TYPES; + + return " + SELECT + nag_watch.watcher_id, + flagtypes.name AS flag_type, + flags.id AS flag_id, + flags.bug_id, + flags.attach_id, + flags.modification_date, + requester.userid AS requester_id, + requestee.userid AS requestee_id + FROM + flags + INNER JOIN flagtypes ON flagtypes.id = flags.type_id + INNER JOIN profiles AS requester ON requester.userid = flags.setter_id + INNER JOIN profiles AS requestee ON requestee.userid = flags.requestee_id + INNER JOIN bugs ON bugs.bug_id = flags.bug_id + INNER JOIN products ON products.id = bugs.product_id + LEFT JOIN attachments ON attachments.attach_id = flags.attach_id + LEFT JOIN nag_defer ON nag_defer.flag_id = flags.id + INNER JOIN nag_watch ON nag_watch.nagged_id = flags.requestee_id + INNER JOIN profiles AS watcher ON watcher.userid = nag_watch.watcher_id + WHERE + " . $dbh->sql_in('flagtypes.name', \@flag_types_sql) . " + AND flags.status = '?' + AND products.nag_interval != 0 + AND TIMESTAMPDIFF(HOUR, flags.modification_date, CURRENT_DATE()) >= products.nag_interval + AND watcher.disable_mail = 0 + ORDER BY + nag_watch.watcher_id, + flags.requestee_id, + flags.modification_date + "; +} + +1; diff --git a/extensions/RequestNagger/lib/TimeAgo.pm b/extensions/RequestNagger/lib/TimeAgo.pm new file mode 100644 index 000000000..3dfbbeaac --- /dev/null +++ b/extensions/RequestNagger/lib/TimeAgo.pm @@ -0,0 +1,186 @@ +# This Source Code Form is subject to the terms of the Mozilla Public +# License, v. 2.0. If a copy of the MPL was not distributed with this +# file, You can obtain one at http://mozilla.org/MPL/2.0/. +# +# This Source Code Form is "Incompatible With Secondary Licenses", as +# defined by the Mozilla Public License, v. 2.0. + +package Bugzilla::Extension::RequestNagger::TimeAgo; + +use strict; +use utf8; +use DateTime; +use Carp; +use Exporter qw(import); + +use if $ENV{ARCH_64BIT}, 'integer'; + +our @EXPORT_OK = qw(time_ago); + +our $VERSION = '0.06'; + +my @ranges = ( + [ -1, 'in the future' ], + [ 60, 'just now' ], + [ 900, 'a few minutes ago'], # 15*60 + [ 3000, 'less than an hour ago'], # 50*60 + [ 4500, 'about an hour ago'], # 75*60 + [ 7200, 'more than an hour ago'], # 2*60*60 + [ 21600, 'several hours ago'], # 6*60*60 + [ 86400, 'today', sub { # 24*60*60 + my $time = shift; + my $now = shift; + if ( $time->day < $now->day + or $time->month < $now->month + or $time->year < $now->year + ) { + return 'yesterday' + } + if ($time->hour < 5) { + return 'tonight' + } + if ($time->hour < 10) { + return 'this morning' + } + if ($time->hour < 15) { + return 'today' + } + if ($time->hour < 19) { + return 'this afternoon' + } + return 'this evening' + }], + [ 172800, 'yesterday'], # 2*24*60*60 + [ 604800, 'this week'], # 7*24*60*60 + [ 1209600, 'last week'], # 2*7*24*60*60 + [ 2678400, 'this month', sub { # 31*24*60*60 + my $time = shift; + my $now = shift; + if ($time->year == $now->year and $time->month == $now->month) { + return 'this month' + } + return 'last month' + }], + [ 5356800, 'last month'], # 2*31*24*60*60 + [ 24105600, 'several months ago'], # 9*31*24*60*60 + [ 31536000, 'about a year ago'], # 365*24*60*60 + [ 34214400, 'last year'], # (365+31)*24*60*60 + [ 63072000, 'more than a year ago'], # 2*365*24*60*60 + [ 283824000, 'several years ago'], # 9*365*24*60*60 + [ 315360000, 'about a decade ago'], # 10*365*24*60*60 + [ 630720000, 'last decade'], # 20*365*24*60*60 + [ 2838240000, 'several decades ago'], # 90*365*24*60*60 + [ 3153600000, 'about a century ago'], # 100*365*24*60*60 + [ 6307200000, 'last century'], # 200*365*24*60*60 + [ 6622560000, 'more than a century ago'], # 210*365*24*60*60 + [ 28382400000, 'several centuries ago'], # 900*365*24*60*60 + [ 31536000000, 'about a millenium ago'], # 1000*365*24*60*60 + [ 63072000000, 'more than a millenium ago'], # 2000*365*24*60*60 +); + +sub time_ago { + my ($time, $now) = @_; + + if (not defined $time or not $time->isa('DateTime')) { + croak('DateTime::Duration::Fuzzy::time_ago needs a DateTime object as first parameter') + } + if (not defined $now) { + $now = DateTime->now(); + } + if (not $now->isa('DateTime')) { + croak('Invalid second parameter provided to DateTime::Duration::Fuzzy::time_ago; it must be a DateTime object if provided') + } + + my $dur = $now->subtract_datetime_absolute($time)->in_units('seconds'); + + foreach my $range ( @ranges ) { + if ( $dur <= $range->[0] ) { + if ( $range->[2] ) { + return $range->[2]->($time, $now) + } + return $range->[1] + } + } + + return 'millenia ago' +} + +1 + +__END__ + +=head1 NAME + +DateTime::Duration::Fuzzy -- express dates as fuzzy human-friendly strings + +=head1 SYNOPSIS + + use DateTime::Duration::Fuzzy qw(time_ago); + use DateTime; + + my $now = DateTime->new( + year => 2010, month => 12, day => 12, + hour => 19, minute => 59, + ); + my $then = DateTime->new( + year => 2010, month => 12, day => 12, + hour => 15, + ); + print time_ago($then, $now); + # outputs 'several hours ago' + + print time_ago($then); + # $now taken from C