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