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