SL/Controller/Mebil.pm

   1 package SL::Controller::Mebil;
   2
   3 use strict;
   4
   5 use parent qw(SL::Controller::Base);
   6
   7 #use SL::Controller::Helper::ReportGenerator;
   8 use SL::ReportGenerator;
   9 use SL::DBUtils;
  10
  11 use SL::Locale::String;  # t8
  12
  13 #use Data::Dumper;
  14 #use SL::ClientJS;
  15
  16 use Rose::Object::MakeMethods::Generic (
  17   scalar                  => [ qw(report number_columns year current_year objects subtotals_per_quarter salesman_id) ],
  18   'scalar --get_set_init' => [ qw(employees types data) ],
  19 );
  20
  21 sub action_map {
  22         $::lxdebug->enter_sub;
  23         $::lxdebug->message(5, 'controller=mebil/action=map');
  24         my ($self) = @_;
  25
  26         $::form->header(no_layout => 1);
  27
  28         print "<h1>Mebil running</h1>";
  29
  30         my $sql = "SELECT  chart_id,xbrl_tag from mebil_mapping";
  31         my $result = SL::DBUtils::do_query($::form, $::form->get_standard_dbh, $sql);
  32         $::lxdebug->message(5, "result= $result");
  33         print "$result<br>\n";
  34
  35         my @r = SL::DBUtils::selectall_hashref_query($::form, $::form->get_standard_dbh, $sql);
  36         print ref($r[1])||"SCALAR";
  37         print "<br>";
  38         my $fst = $r[1];
  39         while (my($k,$v) = each(%$fst)) {
  40                 print $k, " : ", $v, "</br>\n";
  41         }
  42         print "<br>";
  43         print scalar @r;
  44         print "<br>";
  45         print @r;
  46         print "<p>Mebil ready</p>";
  47         $::lxdebug->leave_sub;
  48 }
  49
  50 sub action_showmap {
  51         $::lxdebug->enter_sub;
  52         my ($self) = @_;
  53
  54         # call model
  55         $self->{data} = DB::MebilMapping::getMappings($::form->get_standard_dbh);
  56
  57
  58         $::form->{title} = $::locale->text('Mebil Map');
  59
  60         my $sql = "SELECT fromacc,typ,toacc from mebil_mapping order by ordering";
  61         $self->{data} = SL::DBUtils::selectall_hashref_query($::form, $::form->get_standard_dbh, $sql);
  62
  63         $self->prepare_report;
  64         $self->list_data;
  65
  66         $::lxdebug->leave_sub;
  67 }
  68
  69 sub extract_rule {
  70         my $rule = shift;
  71         my $part = $rule;
  72         $part =~ s/:.*//;
  73         if ($rule =~ /:/) {
  74                 $rule =~ s/[^:]*://;
  75         }
  76         else {
  77                 $rule = "";
  78         }
  79         $::lxdebug->message(5, "part=$part");
  80         return ($part,$rule);
  81 }
  82
  83 sub rule2sql {
  84         $::lxdebug->enter_sub;
  85
  86         my $rule = shift;
  87         my $year = shift;
  88         $::lxdebug->message(5, "rule=$rule");
  89
  90         # a rule consists of key=value pairs seperated by colon. Possible keys are:
  91         # - ACC: account number
  92         # - VALUES=positive|negative: only positive or negative values are selected
  93         #     negative implies INVERT=true
  94         # - INVERT=true: Result is multiplied by -1
  95         # - START=YEAR: start year. Absolute ('2020') or relative ('YEAR/PY')
  96         # - END=YEAR: end year. Default: $year
  97
  98         # supply defaults:
  99         my $acc = "0000";
 100         my $values = "";
 101         my $invert = "";
 102         my $start = "";
 103         my $end = "AND (ac.transdate <= '31.12.$year')";
 104         my $py = $year - 1;
 105
 106         # parse rule
 107         (my $part,$rule) = extract_rule($rule);
 108         $::lxdebug->message(5, "part=$part");
 109         while ($part) {
 110                 $part =~ /(.*)=(.*)/;
 111                 if ($1 eq "ACC") {
 112                         $acc = $2;
 113                 }
 114                 elsif ($1 eq "VALUES") {
 115                         if ($2 eq "positive") {
 116                                 $values = "AND (ac.amount > 0)";
 117                         }
 118                         elsif ($2 eq "negative") {
 119                                 $values = "AND (ac.amount < 0)";
 120                                 $invert = "* (-1)";
 121                         }
 122                         else {
 123                                 die "invalid rule part: $part";
 124                         }
 125                 }
 126                 elsif ($1 eq "INVERT") {
 127                         $invert = "* (-1)";
 128                 }
 129                 elsif ($1 eq "START") {
 130                         $start = "AND (ac.transdate >= '01.01.$2')";
 131                         $start =~ s/YEAR/$year/;
 132                         $start =~ s/PY/$py/;
 133                 }
 134                 elsif ($1 eq "END") {
 135                         $end = "AND (ac.transdate <= '31.12.$2')";
 136                         $end =~ s/YEAR/$year/;
 137                         $end =~ s/PY/$py/;
 138                 }
 139                 else {
 140                         die "invalid rule part: $part";
 141                 }
 142                 ($part,$rule) = extract_rule($rule);
 143         }
 144
 145         $::lxdebug->leave_sub;
 146         return "SELECT SUM(ac.amount) $invert AS saldo
 147                                                 FROM acc_trans ac
 148                                                 JOIN chart c ON (c.id = ac.chart_id)
 149                                                 WHERE (c.accno = '$acc') $values $start $end";
 150 }
 151
 152 sub action_calcmap {
 153         $::lxdebug->enter_sub;
 154         my ($self) = @_;
 155
 156         $self->year($::form->{year} || DateTime->today->year - 1);
 157
 158         $::form->{title} = $::locale->text('Mebil Map');
 159
 160         my $sql = "SELECT  fromacc,typ,toacc from mebil_mapping order by ordering";
 161         $self->{data} = SL::DBUtils::selectall_hashref_query($::form, $::form->get_standard_dbh, $sql);
 162
 163         my %fromacc = ();
 164         my %toacc   = ();
 165         my $year = $self->year;
 166         foreach my $mapping (@{ $self->{data} }) {
 167                 if ($mapping->{typ} eq 'H') {
 168                         # process Haben
 169                         $sql = "SELECT SUM(ac.amount) AS saldo
 170                                                 FROM acc_trans ac
 171                                                 JOIN chart c ON (c.id = ac.chart_id)
 172                                                 WHERE (ac.transdate <= '31.12.$year')
 173                                                 AND (c.accno = '$mapping->{fromacc}') ";
 174                         my $result = SL::DBUtils::selectall_hashref_query($::form, $::form->get_standard_dbh, $sql);
 175                         $fromacc{$mapping->{fromacc}} = $result->[0]->{saldo};
 176                         $toacc{$mapping->{toacc}} += $result->[0]->{saldo};
 177                 }
 178                 elsif ($mapping->{typ} eq 'S') {
 179                         # process Soll
 180                         $sql = "SELECT SUM(ac.amount)* -1 AS saldo
 181                                                 FROM acc_trans ac
 182                                                 JOIN chart c ON (c.id = ac.chart_id)
 183                                                 WHERE (ac.transdate <= '31.12.$year')
 184                                                 AND (c.accno = '$mapping->{fromacc}') ";
 185                         my @result = SL::DBUtils::selectfirst_array_query($::form, $::form->get_standard_dbh, $sql);
 186                         $fromacc{$mapping->{fromacc}} = $result[0];
 187                         $toacc{$mapping->{toacc}} += $result[0];
 188                 }
 189 #               elsif ($mapping->{typ} eq 'V') {
 190 #                       # process Vorjahr
 191 #                       $fromacc{$mapping->{fromacc}} = 300.;
 192 #                       $toacc{$mapping->{toacc}} = 300.;
 193 #               }
 194 #               elsif ($mapping->{typ} eq 'A') {
 195 #                       # process Aktjahr
 196 #                       $fromacc{$mapping->{fromacc}} = 400.;
 197 #                       $toacc{$mapping->{toacc}} = 400.;
 198 #               }
 199                 elsif ($mapping->{typ} eq 'X') {
 200                         # add to other account
 201                         $toacc{$mapping->{toacc}} += $toacc{$mapping->{fromacc}};
 202                 }
 203                 elsif ($mapping->{typ} eq 'Y') {
 204                         # substract from other account
 205                         $toacc{$mapping->{toacc}} -= $toacc{$mapping->{fromacc}};
 206                 }
 207                 elsif ($mapping->{typ} eq 'R') {
 208                         # rule based
 209                         my $sql = rule2sql($mapping->{fromacc}, $year);
 210                         $::lxdebug->message(5, "sql=$sql");
 211                         my @result = SL::DBUtils::selectfirst_array_query($::form, $::form->get_standard_dbh, $sql);
 212                         $toacc{$mapping->{toacc}} += $result[0];
 213                 }
 214                 elsif ($mapping->{typ} eq 'C') {
 215                         # constant value
 216                         ; # do nothing here
 217                 }
 218                 else {
 219                         die "Error: Invalid mapping type: $mapping->{typ}\n";
 220                 }
 221         }
 222
 223         $self->report(SL::ReportGenerator->new(\%::myconfig, $::form));
 224
 225         my @columns = (qw(name amount));
 226
 227         my %column_defs          = (
 228         name                        => { text => 'Konto', align => 'left'   },
 229         amount                      => { text => 'Betrag'   , align => 'right'   },
 230         );
 231
 232   $self->report->set_options(
 233     std_column_visibility => 1,
 234     controller_class      => 'Mebil',
 235     output_format         => 'HTML',
 236         raw_top_info_text     => $self->render('mebil/report_top', { output => 0 }, YEARS_TO_LIST => [ reverse(($self->year - 10)..($self->year + 5)) ]),
 237     title                 => t8('mebil - Mapping: values for #1', $self->year),
 238 #    allow_pdf_export      => 1,
 239 #    allow_csv_export      => 1,
 240   );
 241   $self->report->set_columns(%column_defs);
 242   $self->report->set_column_order(@columns);
 243 #  $self->report->set_export_options(qw(list year subtotals_per_quarter salesman_id));
 244         $self->report->set_options_from_form;
 245         $self->add_data_sorted(\%fromacc);
 246         $self->add_data_sorted(\%toacc);
 247
 248         $::lxdebug->leave_sub;
 249         return $self->report->generate_with_headers;
 250 }
 251 sub add_data_sorted {
 252         my $self = shift;
 253         my $data = shift; # hash reference
 254
 255         foreach my $key (sort keys %$data) {
 256                 my %data = (
 257                     name                     => { data => $key },
 258                 amount                   => { data => $::form->format_amount(\%::myconfig, $data->{$key}, 2) },
 259                 );
 260                 $self->report->add_data(\%data);
 261
 262         }
 263 }
 264 sub prepare_report {
 265   my ($self)      = @_;
 266
 267   $self->report(SL::ReportGenerator->new(\%::myconfig, $::form));
 268
 269   my @columns = (qw(fromacc typ toacc));
 270
 271   #$self->number_columns([ grep { !m/^(?:month|year|quarter)$/ } @columns ]);
 272
 273   my %column_defs          = (
 274     fromacc                  => { text => 'Quelle', align => 'left'   },
 275     typ                      => { text => 'Typ'   , align => 'right'   },
 276     toacc                    => { text => 'Ziel'  , align => 'left'   },
 277   );
 278
 279   #$column_defs{$_}->{align} = 'right' for @columns;
 280
 281   $self->report->set_options(
 282     std_column_visibility => 1,
 283     controller_class      => 'Mebil',
 284     output_format         => 'HTML',
 285  #   raw_top_info_text     => $self->render('financial_overview/report_top', { output => 0 }, YEARS_TO_LIST => [ reverse(($self->current_year - 10)..($self->current_year + 5)) ]),
 286     title                 => 'mebil - Mapping',
 287 #    allow_pdf_export      => 1,
 288 #    allow_csv_export      => 1,
 289   );
 290   $self->report->set_columns(%column_defs);
 291   $self->report->set_column_order(@columns);
 292 #  $self->report->set_export_options(qw(list year subtotals_per_quarter salesman_id));
 293   $self->report->set_options_from_form;
 294 }
 295 sub list_data {
 296         my ($self)           = @_;
 297
 298 #  my @visible_columns  = $self->report->get_visible_columns;
 299 #  my @type_columns     = @{ $self->types };
 300 #  my @non_type_columns = grep { my $c = $_; none { $c eq $_ } @type_columns } @visible_columns;
 301
 302         foreach my $mapping (@{ $self->{data} }) {
 303                 my %data = (
 304                     fromacc                  => { data => $mapping->{fromacc} },
 305                 typ                      => { data => $mapping->{typ}     },
 306                 toacc                    => { data => $mapping->{toacc}   },
 307                 );
 308                 $self->report->add_data(\%data);
 309         }
 310
 311         return $self->report->generate_with_headers;
 312 }
 313
 314 1;