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   *{ $package . '::' . $attribute . '_in_hours' } = sub {
 121     my ($self, $value) = @_;
 122
 123     $self->$attribute(int($value * 60 + 0.5)) if @_ > 1;
 124     return $self->$attribute / 60.0;
 125   };
 126
 127   *{ $package . '::' . $attribute . '_in_hours_as_number' } = sub {
 128     my ($self, $value) = @_;
 129
 130     my $sub = "${attribute}_in_hours";
 131
 132     $self->$sub($::form->parse_amount(\%::myconfig, $value)) if @_ > 1;
 133     return $::form->format_amount(\%::myconfig, $self->$sub, 2);
 134   };
 135 }
 136
 137 1;
 138 __END__
 139
 140 =pod
 141
 142 =encoding utf8
 143
 144 =head1 NAME
 145
 146 SL::DB::Helper::AttrDuration - Attribute helper for duration stored in
 147 numeric columns
 148
 149 =head1 SYNOPSIS
 150
 151   # In a Rose model:
 152   use SL::DB::Helper::AttrDuration;
 153   __PACKAGE__->attr_duration('time_estimation');
 154   __PACKAGE__->attr_duration_minutes('hours');
 155
 156   # Read access:
 157   print "Minutes: " . $obj->time_estimation_as_minutes . " hours: " . $obj->time_estimation_as_hours . "\n";
 158
 159   # Use formatted strings in input fields in templates:
 160   <form method="post">
 161     ...
 162     [% L.input_tag('time_estimation_as_duration_string', SELF.obj.time_estimation_as_duration_string) %]
 163   </form>
 164
 165 =head1 OVERVIEW
 166
 167 This is a helper for columns that store a duration in one of two formats:
 168
 169 =over 2
 170
 171 =item 1. as a numeric or floating point number representing a number
 172 of hours
 173
 174 =item 2. as an integer presenting a number of minutes
 175
 176 =back
 177
 178 In the first case the value 1.75 would stand for "1 hour, 45
 179 minutes". In the second case the value 105 represents the same
 180 duration.
 181
 182 The helper methods created depend on the mode. Calling
 183 C<attr_duration> makes the following methods available:
 184
 185 =over 4
 186
 187 =item C<attribute_as_minutes [$new_value]>
 188
 189 Access only the minutes. Return values are in the range [0 - 59].
 190
 191 =item C<attribute_as_hours [$new_value]>
 192
 193 Access only the hours. Returns an integer value.
 194
 195 =item C<attribute_as_duration_string [$new_value]>
 196
 197 Access the full value as a formatted string according to the user's
 198 locale settings.
 199
 200 =item C<attribute_as_man_days [$new_value]>
 201
 202 Access the attribute as a number of man days which are assumed to be 8
 203 hours long. If the underlying attribute is less than 8 then the value
 204 itself will be returned. Otherwise the value divided by 8 is returned.
 205
 206 If used as a setter then the underlying attribute is simply set to
 207  C<$new_value>. Intentional use is to set the man days first and the
 208  unit later, e.g.
 209
 210   $obj->attribute_as_man_days($::form->{attribute_as_man_days});
 211   $obj->attribute_as_man_days_unit($::form->{attribute_as_man_days_unit});
 212
 213 Note that L<SL::DB::Object/assign_attributes> is aware of this and
 214 handles this case correctly.
 215
 216 =item C<attribute_as_man_days_unit [$new_unit]>
 217
 218 Returns the unit that the number returned by L</attribute_as_man_days>
 219 represents. This can be either C<h> if the underlying attribute is
 220 less than 8 and C<man_day> otherwise.
 221
 222 If used as a setter then the underlying attribute is multiplied by 8
 223 if C<$new_unit> equals C<man_day>. Otherwise the underlying attribute
 224 is not modified. Intentional use is to set the man days first and the
 225 unit later, e.g.
 226
 227   $obj->attribute_as_man_days($::form->{attribute_as_man_days});
 228   $obj->attribute_as_man_days_unit($::form->{attribute_as_man_days_unit});
 229
 230 Note that L<SL::DB::Object/assign_attributes> is aware of this and
 231 handles this case correctly.
 232
 233 =back
 234
 235 With C<attr_duration_minutes> the following methods are available:
 236
 237 =over 4
 238
 239 =item C<attribute_as_minutes [$new_value]>
 240
 241 Access only the minutes. Return values are in the range [0 - 59].
 242
 243 =item C<attribute_as_hours [$new_value]>
 244
 245 Access only the hours. Returns an integer value.
 246
 247 =item C<attribute_as_duration_string [$new_value]>
 248
 249 Access the full value as a formatted string in the form C<h:mm>,
 250 e.g. C<1:30> for the value 90 minutes. Parsing such a string is
 251 supported, too.
 252
 253 =item C<attribute_in_hours [$new_value]>
 254
 255 Access the full value but convert to and from hours when
 256 reading/writing the value.
 257
 258 =item C<attribute_in_hours_as_number [$new_value]>
 259
 260 Access the full value but convert to and from hours when
 261 reading/writing the value. The value is formatted to/parsed from the
 262 user's number format.
 263
 264 =back
 265
 266 =head1 FUNCTIONS
 267
 268 =over 4
 269
 270 =item C<attr_duration @attributes>
 271
 272 Package method. Call with the names of attributes for which the helper
 273 methods should be created.
 274
 275 =item C<attr_duration_minutes @attributes>
 276
 277 Package method. Call with the names of attributes for which the helper
 278 methods should be created.
 279
 280 =back
 281
 282 =head1 BUGS
 283
 284 Nothing here yet.
 285
 286 =head1 AUTHOR
 287
 288 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 289
 290 =cut