SL/DB/Helper/AttrDuration.pm

   1 package SL::DB::Helper::AttrDuration;
   2
   3 use strict;
   4
   5 use parent qw(Exporter);
   6 our @EXPORT = qw(attr_duration attr_duration_minutes);
   7
   8 use Carp;
   9
  10 sub attr_duration {
  11   my ($package, @attributes) = @_;
  12
  13   _make($package, $_) for @attributes;
  14 }
  15
  16 sub attr_duration_minutes {
  17   my ($package, @attributes) = @_;
  18
  19   _make_minutes($package, $_) for @attributes;
  20 }
  21
  22 sub _make {
  23   my ($package, $attribute) = @_;
  24
  25   no strict 'refs';
  26
  27   *{ $package . '::' . $attribute . '_as_hours' } = sub {
  28     my ($self, $value) = @_;
  29
  30     $self->$attribute(int($value) + ($self->$attribute - int($self->$attribute))) if @_ > 1;
  31     return int($self->$attribute // 0);
  32   };
  33
  34   *{ $package . '::' . $attribute . '_as_minutes' } = sub {
  35     my ($self, $value) = @_;
  36
  37     $self->$attribute(int($self->$attribute) * 1.0 + ($value // 0) / 60.0) if @_ > 1;
  38     return int(($self->$attribute // 0) * 60.0 + 0.5) % 60;
  39   };
  40
  41   *{ $package . '::' . $attribute . '_as_duration_string' } = sub {
  42     my ($self, $value) = @_;
  43
  44     $self->$attribute(defined($value) ? $::form->parse_amount(\%::myconfig, $value) * 1 : undef) if @_ > 1;
  45     return defined($self->$attribute) ? $::form->format_amount(\%::myconfig, $self->$attribute // 0, 2) : undef;
  46   };
  47
  48   *{ $package . '::' . $attribute . '_as_man_days' } = sub {
  49     my ($self, $value) = @_;
  50
  51     if (@_ > 1) {
  52       return undef if !defined $value;
  53       $self->$attribute($value);
  54     }
  55     $value = $self->$attribute // 0;
  56     return $value >= 8.0 ? $value / 8.0 : $value;
  57   };
  58
  59   *{ $package . '::' . $attribute . '_as_man_days_unit' } = sub {
  60     my ($self, $unit) = @_;
  61
  62     if (@_ > 1) {
  63       return undef if !defined $unit;
  64       croak "Unknown unit '${unit}'"                    if $unit !~ m/^(?:h|hour|man_day)$/;
  65       $self->$attribute(($self->$attribute // 0) * 8.0) if $unit eq 'man_day';
  66     }
  67
  68     return ($self->$attribute // 0) >= 8.0 ? 'man_day' : 'h'
  69   };
  70
  71   *{ $package . '::' . $attribute . '_as_man_days_string' } = sub {
  72     my ($self, $value) = @_;
  73     my $method         = "${attribute}_as_man_days";
  74
  75     if (@_ > 1) {
  76       return undef if !defined $value;
  77       $self->$method($::form->parse_amount(\%::myconfig, $value));
  78     }
  79
  80     return $::form->format_amount(\%::myconfig, $self->$method // 0, 2);
  81   };
  82 }
  83
  84 sub _make_minutes {
  85   my ($package, $attribute) = @_;
  86
  87   no strict 'refs';
  88
  89   *{ $package . '::' . $attribute . '_as_hours' } = sub {
  90     my ($self, $value) = @_;
  91
  92     $self->$attribute($value * 60 + ($self->$attribute % 60)) if @_ > 1;
  93     return int(($self->$attribute // 0) / 60);
  94   };
  95
  96   *{ $package . '::' . $attribute . '_as_minutes' } = sub {
  97     my ($self, $value) = @_;
  98
  99     $self->$attribute(int($self->$attribute) - (int($self->$attribute) % 60) + ($value // 0)) if @_ > 1;
 100     return ($self->$attribute // 0) % 60;
 101   };
 102
 103   *{ $package . '::' . $attribute . '_as_duration_string' } = sub {
 104     my ($self, $value) = @_;
 105
 106     if (@_ > 1) {
 107       if (!defined($value) || ($value eq '')) {
 108         $self->$attribute(undef);
 109       } else {
 110         croak $::locale->text("Invalid duration format") if $value !~ m{^(?:(\d*):)?(\d+)$};
 111         $self->$attribute(($1 // 0) * 60 + ($2 // 0));
 112       }
 113     }
 114
 115     my $as_hours   = "${attribute}_as_hours";
 116     my $as_minutes = "${attribute}_as_minutes";
 117     return defined($self->$attribute) ? sprintf('%d:%02d', $self->$as_hours, $self->$as_minutes) : undef;
 118   };
 119 }
 120
 121 1;
 122 __END__
 123
 124 =pod
 125
 126 =encoding utf8
 127
 128 =head1 NAME
 129
 130 SL::DB::Helper::AttrDuration - Attribute helper for duration stored in
 131 numeric columns
 132
 133 =head1 SYNOPSIS
 134
 135   # In a Rose model:
 136   use SL::DB::Helper::AttrDuration;
 137   __PACKAGE__->attr_duration('time_estimation');
 138   __PACKAGE__->attr_duration_minutes('hours');
 139
 140   # Read access:
 141   print "Minutes: " . $obj->time_estimation_as_minutes . " hours: " . $obj->time_estimation_as_hours . "\n";
 142
 143   # Use formatted strings in input fields in templates:
 144   <form method="post">
 145     ...
 146     [% L.input_tag('time_estimation_as_duration_string', SELF.obj.time_estimation_as_duration_string) %]
 147   </form>
 148
 149 =head1 OVERVIEW
 150
 151 This is a helper for columns that store a duration in one of two formats:
 152
 153 =over 2
 154
 155 =item 1. as a numeric or floating point number representing a number
 156 of hours
 157
 158 =item 2. as an integer presenting a number of minutes
 159
 160 =back
 161
 162 In the first case the value 1.75 would stand for "1 hour, 45
 163 minutes". In the second case the value 105 represents the same
 164 duration.
 165
 166 The helper methods created depend on the mode. Calling
 167 C<attr_duration> makes the following methods available:
 168
 169 =over 4
 170
 171 =item C<attribute_as_minutes [$new_value]>
 172
 173 Access only the minutes. Return values are in the range [0 - 59].
 174
 175 =item C<attribute_as_hours [$new_value]>
 176
 177 Access only the hours. Returns an integer value.
 178
 179 =item C<attribute_as_duration_string [$new_value]>
 180
 181 Access the full value as a formatted string according to the user's
 182 locale settings.
 183
 184 =item C<attribute_as_man_days [$new_value]>
 185
 186 Access the attribute as a number of man days which are assumed to be 8
 187 hours long. If the underlying attribute is less than 8 then the value
 188 itself will be returned. Otherwise the value divided by 8 is returned.
 189
 190 If used as a setter then the underlying attribute is simply set to
 191  C<$new_value>. Intentional use is to set the man days first and the
 192  unit later, e.g.
 193
 194   $obj->attribute_as_man_days($::form->{attribute_as_man_days});
 195   $obj->attribute_as_man_days_unit($::form->{attribute_as_man_days_unit});
 196
 197 Note that L<SL::DB::Object/assign_attributes> is aware of this and
 198 handles this case correctly.
 199
 200 =item C<attribute_as_man_days_unit [$new_unit]>
 201
 202 Returns the unit that the number returned by L</attribute_as_man_days>
 203 represents. This can be either C<h> if the underlying attribute is
 204 less than 8 and C<man_day> otherwise.
 205
 206 If used as a setter then the underlying attribute is multiplied by 8
 207 if C<$new_unit> equals C<man_day>. Otherwise the underlying attribute
 208 is not modified. Intentional use is to set the man days first and the
 209 unit later, e.g.
 210
 211   $obj->attribute_as_man_days($::form->{attribute_as_man_days});
 212   $obj->attribute_as_man_days_unit($::form->{attribute_as_man_days_unit});
 213
 214 Note that L<SL::DB::Object/assign_attributes> is aware of this and
 215 handles this case correctly.
 216
 217 =back
 218
 219 With C<attr_duration_minutes> the following methods are available:
 220
 221 =over 4
 222
 223 =item C<attribute_as_minutes [$new_value]>
 224
 225 Access only the minutes. Return values are in the range [0 - 59].
 226
 227 =item C<attribute_as_hours [$new_value]>
 228
 229 Access only the hours. Returns an integer value.
 230
 231 =item C<attribute_as_duration_string [$new_value]>
 232
 233 Access the full value as a formatted string in the form C<h:mm>,
 234 e.g. C<1:30> for the value 90 minutes. Parsing such a string is
 235 supported, too.
 236
 237 =back
 238
 239 =head1 FUNCTIONS
 240
 241 =over 4
 242
 243 =item C<attr_duration @attributes>
 244
 245 Package method. Call with the names of attributes for which the helper
 246 methods should be created.
 247
 248 =item C<attr_duration_minutes @attributes>
 249
 250 Package method. Call with the names of attributes for which the helper
 251 methods should be created.
 252
 253 =back
 254
 255 =head1 BUGS
 256
 257 Nothing here yet.
 258
 259 =head1 AUTHOR
 260
 261 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 262
 263 =cut