SL/DB/RecordTemplate.pm

   1 package SL::DB::RecordTemplate;
   2
   3 use strict;
   4
   5 use DateTime::Format::Strptime;
   6 use List::Util qw(first);
   7
   8 use SL::DB::MetaSetup::RecordTemplate;
   9 use SL::DB::Manager::RecordTemplate;
  10
  11 __PACKAGE__->meta->add_relationship(
  12   record_template_items => {
  13     type       => 'one to many',
  14     class      => 'SL::DB::RecordTemplateItem',
  15     column_map => { id => 'record_template_id' },
  16   },
  17 );
  18
  19 __PACKAGE__->meta->initialize;
  20
  21 sub items { goto &record_template_items; }
  22
  23 sub _replace_variables {
  24   my ($self, %params) = @_;
  25
  26   foreach my $sub (@{ $params{fields} }) {
  27     my $value = $params{object}->$sub;
  28     next if ($value // '') eq '';
  29
  30     $value =~ s{ <\% ([a-z0-9_]+) ( \s+ format \s*=\s* (.*?) \s* )? \%> }{
  31       my ($key, $format) = ($1, $3);
  32       my $new_value;
  33
  34       if (!$params{variables}->{$key}) {
  35         $new_value = '';
  36
  37       } elsif ($format) {
  38         $new_value = DateTime::Format::Strptime->new(
  39           pattern     => $format,
  40           locale      => 'de_DE',
  41           time_zone   => 'local',
  42         )->format_datetime($params{variables}->{$key}->[0]);
  43
  44       } else {
  45         $new_value = $params{variables}->{$1}->[1]->($params{variables}->{$1}->[0]);
  46       }
  47
  48       $new_value;
  49
  50     }eigx;
  51
  52     $params{object}->$sub($value);
  53   }
  54 }
  55
  56 sub _generate_variables {
  57   my ($self, $reference_date) = @_;
  58
  59   $reference_date           //= DateTime->today_local;
  60   my @month_names             = (
  61     $::locale->text('January'), $::locale->text('February'), $::locale->text('March'),     $::locale->text('April'),   $::locale->text('May'),      $::locale->text('June'),
  62     $::locale->text('July'),    $::locale->text('August'),   $::locale->text('September'), $::locale->text('October'), $::locale->text('November'), $::locale->text('December'),
  63   );
  64
  65   my $variables = {
  66     current_quarter     => [ $reference_date->clone->truncate(to => 'month'),                        sub { $_[0]->quarter } ],
  67     previous_quarter    => [ $reference_date->clone->truncate(to => 'month')->subtract(months => 3), sub { $_[0]->quarter } ],
  68     next_quarter        => [ $reference_date->clone->truncate(to => 'month')->add(     months => 3), sub { $_[0]->quarter } ],
  69
  70     current_month       => [ $reference_date->clone->truncate(to => 'month'),                        sub { $_[0]->month } ],
  71     previous_month      => [ $reference_date->clone->truncate(to => 'month')->subtract(months => 1), sub { $_[0]->month } ],
  72     next_month          => [ $reference_date->clone->truncate(to => 'month')->add(     months => 1), sub { $_[0]->month } ],
  73
  74     current_month_long  => [ $reference_date->clone->truncate(to => 'month'),                        sub { $month_names[ $_[0]->month - 1 ] } ],
  75     previous_month_long => [ $reference_date->clone->truncate(to => 'month')->subtract(months => 1), sub { $month_names[ $_[0]->month - 1 ] } ],
  76     next_month_long     => [ $reference_date->clone->truncate(to => 'month')->add(     months => 1), sub { $month_names[ $_[0]->month - 1 ] } ],
  77
  78     current_year        => [ $reference_date->clone->truncate(to => 'year'),                         sub { $_[0]->year } ],
  79     previous_year       => [ $reference_date->clone->truncate(to => 'year')->subtract(years => 1),   sub { $_[0]->year } ],
  80     next_year           => [ $reference_date->clone->truncate(to => 'year')->add(     years => 1),   sub { $_[0]->year } ],
  81
  82     reference_date      => [ $reference_date->clone,                                                 sub { $::locale->format_date(\%::myconfig, $_[0]) } ],
  83   };
  84
  85   return $variables;
  86 }
  87
  88 sub _text_column_names {
  89   my ($self, $object) = @_;
  90   return map { $_->name } grep { ref($_) =~ m{::Text} } @{ $object->meta->columns };
  91 }
  92
  93 sub substitute_variables {
  94   my ($self, $reference_date) = @_;
  95
  96   my $variables    = $self->_generate_variables($reference_date);
  97   my @text_columns = $self->_text_column_names($self);
  98
  99   $self->_replace_variables(
 100     object    => $self,
 101     variables => $variables,
 102     fields    => \@text_columns,
 103   );
 104
 105   @text_columns = $self->_text_column_names(SL::DB::RecordTemplateItem->new);
 106
 107   foreach my $item (@{ $self->items }) {
 108     $self->_replace_variables(
 109       object    => $item,
 110       variables => $variables,
 111       fields    => \@text_columns,
 112     );
 113   }
 114 }
 115
 116 sub template_name_to_use {
 117   my ($self, @names) = @_;
 118
 119   return first { ($_ // '') ne '' } (@names, $self->template_name, $::locale->text('unnamed record template'));
 120 }
 121
 122 1;
 123 __END__
 124
 125 =pod
 126
 127 =encoding utf8
 128
 129 =head1 NAME
 130
 131 SL::DB::RecordTemplate — Templates for accounts receivable
 132 transactions, accounts payable transactions and generic ledger
 133 transactiona
 134
 135 =head1 FUNCTIONS
 136
 137 =over 4
 138
 139 =item C<items>
 140
 141 An alias for C<record_template_items>.
 142
 143 =item C<substitute_variables> C<[$reference_date]>
 144
 145 Texts in record templates can contain placeholders. This function
 146 replaces those placeholders by their actual value. Placeholders use
 147 the syntax C<E<lt>%variableE<gt>> or C<E<lt>%variable format=…E<gt>>
 148 for a custom format (see L<DateTime::Format::Strptime> for available
 149 formatting characters).
 150
 151 The variables are calculated based on C<$reference_date> which must be
 152 an instance of L<DateTime> if given. If left out, it defaults to the
 153 current day.
 154
 155 Supported variables are:
 156
 157 =over 2
 158
 159 =item * C<current_quarter>, C<previous_quarter>, C<next_quarter> — the
 160 quarter as a number between 1 and 4 inclusively
 161
 162 =item * C<current_month>, C<previous_month>, C<next_month> — the
 163 month as a number between 1 and 12 inclusively
 164
 165 =item * C<current_month_long>, C<previous_month_long>,
 166 C<next_month_long> — the month's name (e.g. C<August>).
 167
 168 =item * C<current_year>, C<previous_year>, C<next_year> — the
 169 year (e.g. C<2017>)
 170
 171 =item * C<reference_date> — the reference date in the user's date style
 172 (e.g. C<27.11.2017>)
 173
 174 =back
 175
 176 =back
 177
 178 =head1 AUTHOR
 179
 180 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 181
 182 =cut