Merge branch 'b-3.6.1' of ../kivitendo-erp_20220811
[kivitendo-erp.git] / SL / Template / OpenDocument.pm
index 085fa25..66d8f83 100644 (file)
@@ -6,15 +6,21 @@ use Archive::Zip;
 use Encode;
 use HTML::Entities;
 use POSIX 'setsid';
+use XML::LibXML;
 
 use SL::Iconv;
 use SL::Template::OpenDocument::Styles;
 
+use SL::DB::BankAccount;
+use SL::Helper::QrBill;
+use SL::Helper::ISO3166;
+
 use Cwd;
 # use File::Copy;
 # use File::Spec;
 # use File::Temp qw(:mktemp);
 use IO::File;
+use List::Util qw(first);
 
 use strict;
 
@@ -70,30 +76,50 @@ my %html_replace = (
 sub _format_html {
   my ($self, $content, %params) = @_;
 
-  $content                      =~ s{ ^<p> | </p>$ }{}gx;
-  $content                      =~ s{ \r+ }{}gx;
-  $content                      =~ s{ \n+ }{ }gx;
-  $content                      =~ s{ \s+ }{ }gx;
+  my $in_p        = 0;
+  my $p_start_tag = qq|<text:p text:style-name="@{[ $self->{current_text_style} ]}">|;
+  my $prefix      = '';
+  my $suffix      = '';
+
+  my (@tags_to_open, @tags_to_close);
+  for (my $idx = scalar(@{ $self->{tag_stack} }) - 1; $idx >= 0; --$idx) {
+    my $tag = $self->{tag_stack}->[$idx];
 
-  my $in_p                      = 1;
-  my $p_start_tag               = qq|<text:p text:style-name="@{[ $self->{current_text_style} ]}">|;
-  my $ul_start_tag              = qq|<text:list xml:id="list@{[ int rand(9999999999999999) ]}" text:style-name="LKIVITENDOitemize@{[ $self->{current_text_style} ]}">|;
-  my $ol_start_tag              = qq|<text:list xml:id="list@{[ int rand(9999999999999999) ]}" text:style-name="LKIVITENDOenumerate@{[ $self->{current_text_style} ]}">|;
-  my $ul_li_start_tag           = qq|<text:list-item><text:p text:style-name="PKIVITENDOitemize@{[ $self->{current_text_style} ]}">|;
-  my $ol_li_start_tag           = qq|<text:list-item><text:p text:style-name="PKIVITENDOenumerate@{[ $self->{current_text_style} ]}">|;
+    next if $tag =~ m{/>$};
+    last if $tag =~ m{^<table};
+
+    if ($tag =~ m{^<text:p}) {
+      $in_p        = 1;
+      $p_start_tag = $tag;
+      last;
+
+    } else {
+      $suffix  =  "${tag}${suffix}";
+      $tag     =~ s{ .*>}{>};
+      $prefix .=  '</' . substr($tag, 1);
+    }
+  }
+
+  $content            =~ s{ ^<p> | </p>$ }{}gx if $in_p;
+  $content            =~ s{ \r+ }{}gx;
+  $content            =~ s{ \n+ }{ }gx;
+  $content            =~ s{ (?:\&nbsp;|\s)+ }{ }gx;
+
+  my $ul_start_tag    = qq|<text:list xml:id="list@{[ int rand(9999999999999999) ]}" text:style-name="LKIVITENDOitemize@{[ $self->{current_text_style} ]}">|;
+  my $ol_start_tag    = qq|<text:list xml:id="list@{[ int rand(9999999999999999) ]}" text:style-name="LKIVITENDOenumerate@{[ $self->{current_text_style} ]}">|;
+  my $ul_li_start_tag = qq|<text:list-item><text:p text:style-name="PKIVITENDOitemize@{[ $self->{current_text_style} ]}">|;
+  my $ol_li_start_tag = qq|<text:list-item><text:p text:style-name="PKIVITENDOenumerate@{[ $self->{current_text_style} ]}">|;
 
   my @parts = map {
     if (substr($_, 0, 1) eq '<') {
       s{ +}{}g;
       if ($_ eq '</p>') {
         $in_p--;
-        '</text:p>';
+        $in_p == 0 ? '</text:p>' : '';
 
       } elsif ($_ eq '<p>') {
-        if (!$in_p) {
-          $in_p = 1;
-          $p_start_tag;
-        }
+        $in_p++;
+        $in_p == 1 ? $p_start_tag : '';
 
       } elsif ($_ eq '<ul>') {
         $self->{used_list_styles}->{itemize}->{$self->{current_text_style}}   = 1;
@@ -114,10 +140,9 @@ sub _format_html {
     }
   } split(m{(<.*?>)}x, $content);
 
-  my $out  = join('', @parts);
-  $out    .= $p_start_tag if !$in_p;
+  my $out  = join('', $prefix, @parts, $suffix);
 
-  # $::lxdebug->message(0, "out $out");
+  # $::lxdebug->dump(0, "prefix parts suffix", [ $prefix, join('', @parts), $suffix ]);
 
   return $out;
 }
@@ -210,12 +235,14 @@ sub parse_block {
 
   while ($contents ne "") {
     if (substr($contents, 0, 1) eq "<") {
-      $contents =~ m|^<[^>]+>|;
-      my $tag = $&;
-      substr($contents, 0, length($&)) = "";
+      $contents =~ m|^(<[^>]+>)|;
+      my $tag = $1;
+      substr($contents, 0, length($1)) = "";
 
       $self->{current_text_style} = $1 if $tag =~ m|text:style-name\s*=\s*"([^"]+)"|;
 
+      push @{ $self->{tag_stack} }, $tag;
+
       if ($tag =~ m|<table:table-row|) {
         $contents =~ m|^(.*?)(</table:table-row[^>]*>)|;
         my $table_row = $1;
@@ -224,10 +251,10 @@ sub parse_block {
         if ($table_row =~ m|\&lt;\%foreachrow\s+(.*?)\%\&gt;|) {
           my $var = $1;
 
-          $contents =~ m|\&lt;\%foreachrow\s+.*?\%\&gt;|;
-          substr($contents, length($`), length($&)) = "";
+          $contents =~ m|^(.*?)(\&lt;\%foreachrow\s+.*?\%\&gt;)|;
+          substr($contents, length($1), length($2)) = "";
 
-          ($table_row, $contents) = $self->find_end($contents, length($`));
+          ($table_row, $contents) = $self->find_end($contents, length($1));
           if (!$table_row) {
             $self->{"error"} = "Unclosed <\%foreachrow\%>." unless ($self->{"error"});
             $main::lxdebug->leave_sub();
@@ -238,7 +265,7 @@ sub parse_block {
           $table_row .=  $1;
           $end_tag    =  $2;
 
-          substr $contents, 0, length($&), '';
+          substr $contents, 0, length($1) + length($2), '';
 
           my $new_text = $self->parse_foreach($var, $table_row, $tag, $end_tag, @indices);
           if (!defined($new_text)) {
@@ -261,9 +288,14 @@ sub parse_block {
         $new_contents .= $tag;
       }
 
+      if ($tag =~ m{^</ | />$}x) {
+        # $::lxdebug->message(0, "popping top tag is $tag top " . $self->{tag_stack}->[-1]);
+        pop @{ $self->{tag_stack} };
+      }
+
     } else {
-      $contents =~ /^[^<]+/;
-      my $text = $&;
+      $contents =~ /^([^<]+)/;
+      my $text = $1;
 
       my $pos_if = index($text, '&lt;%if');
       my $pos_foreach = index($text, '&lt;%foreach');
@@ -278,15 +310,15 @@ sub parse_block {
         $new_contents .= $self->substitute_vars(substr($contents, 0, $pos_foreach), @indices);
         substr($contents, 0, $pos_foreach) = "";
 
-        if ($contents !~ m|^\&lt;\%foreach (.*?)\%\&gt;|) {
+        if ($contents !~ m|^(\&lt;\%foreach (.*?)\%\&gt;)|) {
           $self->{"error"} = "Malformed <\%foreach\%>.";
           $main::lxdebug->leave_sub();
           return undef;
         }
 
-        my $var = $1;
+        my $var = $2;
 
-        substr($contents, 0, length($&)) = "";
+        substr($contents, 0, length($1)) = "";
 
         my $block;
         ($block, $contents) = $self->find_end($contents);
@@ -320,11 +352,20 @@ sub parse_block {
 sub parse {
   $main::lxdebug->enter_sub();
   my $self = $_[0];
+
   local *OUT = $_[1];
   my $form = $self->{"form"};
 
   close(OUT);
 
+  my $qr_image_path;
+  if ($::instance_conf->get_create_qrbill_invoices && $form->{formname} eq 'invoice') {
+    # the biller account information, biller address and the reference number,
+    # are needed in the template aswell as in the qr-code generation, therefore
+    # assemble these and add to $::form
+    $qr_image_path = $self->generate_qr_code;
+  }
+
   my $file_name;
   if ($form->{"IN"} =~ m|^/|) {
     $file_name = $form->{"IN"};
@@ -356,8 +397,9 @@ sub parse {
   if ($self->{use_template_toolkit}) {
     my $additional_params = $::form;
 
-    $::form->init_template->process(\$contents, $additional_params, \$new_contents) || die $::form->template->error;
+    $::form->template->process(\$contents, $additional_params, \$new_contents) || die $::form->template->error;
   } else {
+    $self->{tag_stack} = [];
     $new_contents = $self->parse_block($contents);
   }
   if (!defined($new_contents)) {
@@ -393,6 +435,28 @@ sub parse {
     $zip->contents("styles.xml", Encode::encode('utf-8-strict', $new_styles));
   }
 
+  if ($::instance_conf->get_create_qrbill_invoices && $form->{formname} eq 'invoice') {
+    # get placeholder path from odt XML
+    my $qr_placeholder_path;
+    my $dom = XML::LibXML->load_xml(string => $contents);
+    my @nodelist = $dom->getElementsByTagName("draw:frame");
+    for my $node (@nodelist) {
+      my $attr = $node->getAttribute('draw:name');
+      if ($attr eq 'QRCodePlaceholder') {
+        my @children = $node->getChildrenByTagName('draw:image');
+        $qr_placeholder_path = $children[0]->getAttribute('xlink:href');
+      }
+    }
+    if (!defined($qr_placeholder_path)) {
+      $::form->error($::locale->text('QR-Code placeholder image: QRCodePlaceholder not found in template.'));
+    }
+    # replace QR-Code Placeholder Image in zip file (odt) with generated one
+    $zip->updateMember(
+     $qr_placeholder_path,
+     $qr_image_path
+    );
+  }
+
   $zip->writeToFileNamed($form->{"tmpfile"}, 1);
 
   my $res = 1;
@@ -404,6 +468,276 @@ sub parse {
   return $res;
 }
 
+sub get_qrbill_account {
+  $main::lxdebug->enter_sub();
+  my ($self) = @_;
+
+  my $qr_account;
+
+  my $bank_accounts     = SL::DB::Manager::BankAccount->get_all;
+  $qr_account = scalar(@{ $bank_accounts }) == 1 ?
+    $bank_accounts->[0] :
+    first { $_->use_for_qrbill } @{ $bank_accounts };
+
+  if (!$qr_account) {
+    $::form->error($::locale->text('No bank account flagged for QRBill usage was found.'));
+  }
+
+  $main::lxdebug->leave_sub();
+  return $qr_account;
+}
+
+sub remove_letters_prefix {
+  my $s = $_[0];
+  $s =~ s/^[a-zA-Z]+//;
+  return $s;
+}
+
+sub check_digits_and_max_length {
+  my $s = $_[0];
+  my $length = $_[1];
+
+  return 0 if (!($s =~ /^\d*$/) || length($s) > $length);
+  return 1;
+}
+
+sub calculate_check_digit {
+  # calculate ESR check digit using algorithm: "modulo 10, recursive"
+  my $ref_number_str = $_[0];
+
+  my @m = (0, 9, 4, 6, 8, 2, 7, 1, 3, 5);
+  my $carry = 0;
+
+  my @ref_number_split = map int($_), split(//, $ref_number_str);
+
+  for my $v (@ref_number_split) {
+    $carry = @m[($carry + $v) % 10];
+  }
+
+  return (10 - $carry) % 10;
+}
+
+sub assemble_ref_number {
+  $main::lxdebug->enter_sub();
+
+  my $bank_id = $_[0];
+  my $customer_number = $_[1];
+  my $order_number = $_[2] // "0";
+  my $invoice_number = $_[3] // "0";
+
+  # check values (analog to checks in makro)
+  # - bank_id
+  #     input: 6 digits, only numbers
+  #     output: 6 digits, only numbers
+  if (!($bank_id =~ /^\d*$/) || length($bank_id) != 6) {
+    $::form->error($::locale->text('Bank account id number invalid. Must be 6 digits.'));
+  }
+
+  # - customer_number
+  #     input: prefix (letters) + up to 6 digits (numbers)
+  #     output: prefix removed, 6 digits, filled with leading zeros
+  $customer_number = remove_letters_prefix($customer_number);
+  if (!check_digits_and_max_length($customer_number, 6)) {
+    $::form->error($::locale->text('Customer number invalid. Must be less then or equal to 6 digits after prefix.'));
+  }
+  # fill with zeros
+  $customer_number = sprintf "%06d", $customer_number;
+
+  # - order_number
+  #     input: prefix (letters) + up to 7 digits, may be zero
+  #     output: prefix removed, 7 digits, filled with leading zeros
+  $order_number = remove_letters_prefix($order_number);
+  if (!check_digits_and_max_length($order_number, 7)) {
+    $::form->error($::locale->text('Order number invalid. Must be less then or equal to 7 digits after prefix.'));
+  }
+  # fill with zeros
+  $order_number = sprintf "%07d", $order_number;
+
+  # - invoice_number
+  #     input: prefix (letters) + up to 7 digits, may be zero
+  #     output: prefix removed, 7 digits, filled with leading zeros
+  $invoice_number = remove_letters_prefix($invoice_number);
+  if (!check_digits_and_max_length($invoice_number, 7)) {
+    $::form->error($::locale->text('Invoice number invalid. Must be less then or equal to 7 digits after prefix.'));
+  }
+  # fill with zeros
+  $invoice_number = sprintf "%07d", $invoice_number;
+
+  # assemble ref. number
+  my $ref_number = $bank_id . $customer_number . $order_number . $invoice_number;
+
+  # calculate check digit
+  my $ref_number_cpl = $ref_number . calculate_check_digit($ref_number);
+
+  $main::lxdebug->leave_sub();
+  return $ref_number_cpl;
+}
+
+sub get_ref_number_formatted {
+  $main::lxdebug->enter_sub();
+
+  my $ref_number = $_[0];
+
+  # create ref. number in format:
+  # 'XX XXXXX XXXXX XXXXX XXXXX XXXXX' (2 digits + 5 x 5 digits)
+  my $ref_number_spaced = substr($ref_number, 0, 2) . ' ' .
+                          substr($ref_number, 2, 5) . ' ' .
+                          substr($ref_number, 7, 5) . ' ' .
+                          substr($ref_number, 12, 5) . ' ' .
+                          substr($ref_number, 17, 5) . ' ' .
+                          substr($ref_number, 22, 5);
+
+  $main::lxdebug->leave_sub();
+  return $ref_number_spaced;
+}
+
+sub get_iban_formatted {
+  $main::lxdebug->enter_sub();
+
+  my $iban = $_[0];
+
+  # create iban number in format:
+  # 'XXXX XXXX XXXX XXXX XXXX X' (5 x 4 + 1digits)
+  my $iban_spaced = substr($iban, 0, 4) . ' ' .
+                    substr($iban, 4, 4) . ' ' .
+                    substr($iban, 8, 4) . ' ' .
+                    substr($iban, 12, 4) . ' ' .
+                    substr($iban, 16, 4) . ' ' .
+                    substr($iban, 20, 1);
+
+  $main::lxdebug->leave_sub();
+  return $iban_spaced;
+}
+
+sub get_amount_formatted {
+  $main::lxdebug->enter_sub();
+
+  unless ($_[0] =~ /^\d+\.\d{2}$/) {
+    $::form->error($::locale->text('Amount has wrong format.'));
+  }
+
+  local $_ = shift;
+  $_ = reverse split //;
+  m/^\d{2}\./g;
+  s/\G(\d{3})(?=\d)/$1 /g;
+
+  $main::lxdebug->leave_sub();
+  return scalar reverse split //;
+}
+
+sub generate_qr_code {
+  $main::lxdebug->enter_sub();
+  my $self = $_[0];
+  my $form = $self->{"form"};
+
+  # assemble data for QR-Code
+
+  # get qr-account data
+  my $qr_account = $self->get_qrbill_account();
+
+  my %biller_information = (
+    'iban' => $qr_account->{'iban'}
+  );
+
+  my $biller_countrycode = SL::Helper::ISO3166::map_name_to_alpha_2_code(
+    $::instance_conf->get_address_country()
+  );
+  if (!$biller_countrycode) {
+    $::form->error($::locale->text('Error mapping biller countrycode.'));
+  }
+  my %biller_data = (
+    'address_type' => 'K',
+    'company' => $::instance_conf->get_company(),
+    'address_row1' => $::instance_conf->get_address_street1(),
+    'address_row2' => $::instance_conf->get_address_zipcode() . ' ' . $::instance_conf->get_address_city(),
+    'countrycode' => $biller_countrycode,
+  );
+
+  my $amount;
+  if ($form->{'qrbill_without_amount'}) {
+    $amount = '';
+  } else {
+    $amount = sprintf("%.2f", $form->parse_amount(\%::myconfig, $form->{'total'}));
+  }
+
+  my %payment_information = (
+    'amount' => $amount,
+    'currency' => $form->{'currency'},
+  );
+
+  my $customer_countrycode = SL::Helper::ISO3166::map_name_to_alpha_2_code($form->{'country'});
+  if (!$customer_countrycode) {
+    $::form->error($::locale->text('Error mapping customer countrycode.'));
+  }
+  my %invoice_recipient_data = (
+    'address_type' => 'K',
+    'name' => $form->{'name'},
+    'address_row1' => $form->{'street'},
+    'address_row2' => $form->{'zipcode'} . ' ' . $form->{'city'},
+    'countrycode' => $customer_countrycode,
+  );
+
+  my %ref_nr_data;
+  if ($::instance_conf->get_create_qrbill_invoices == 1) {
+    # generate ref.-no. with check digit
+    my $ref_number = assemble_ref_number(
+      $qr_account->{'bank_account_id'},
+      $form->{'customernumber'},
+      $form->{'ordnumber'},
+      $form->{'invnumber'},
+    );
+    %ref_nr_data = (
+      'type' => 'QRR',
+      'ref_number' => $ref_number,
+    );
+    # get ref. number/iban formatted with spaces and set into form for template
+    # processing
+    $form->{'ref_number'} = $ref_number;
+    $form->{'ref_number_formatted'} = get_ref_number_formatted($ref_number);
+  } elsif ($::instance_conf->get_create_qrbill_invoices == 2) {
+    %ref_nr_data = (
+      'type' => 'NON',
+      'ref_number' => '',
+    );
+  } else {
+    $::form->error($::locale->text('Error getting QR-Bill type.'));
+  }
+
+  # set into form for template processing
+  $form->{'biller_information'} = \%biller_information;
+  $form->{'biller_data'} = \%biller_data;
+  $form->{'iban_formatted'} = get_iban_formatted($qr_account->{'iban'});
+
+  # format amount for template
+  $form->{'amount_formatted'} = get_amount_formatted(
+    sprintf(
+      "%.2f",
+      $form->parse_amount(\%::myconfig, $form->{'total'})
+    )
+  );
+
+  # set outfile
+  my $outfile = $form->{"tmpdir"} . '/' . 'qr-code.png';
+
+  # generate QR-Code Image
+  eval {
+   my $qr_image = SL::Helper::QrBill->new(
+     \%biller_information,
+     \%biller_data,
+     \%payment_information,
+     \%invoice_recipient_data,
+     \%ref_nr_data,
+   );
+   $qr_image->generate($outfile);
+  } or do {
+   local $_ = $@; chomp; my $error = $_;
+   $::form->error($::locale->text('QR-Image generation failed: ' . $error));
+  };
+
+  $main::lxdebug->leave_sub();
+  return $outfile;
+}
+
 sub is_xvfb_running {
   $main::lxdebug->enter_sub();
 
@@ -483,7 +817,9 @@ sub spawn_xvfb {
 
   $main::lxdebug->message(LXDebug->DEBUG2(), "  xauthority $xauthority\n");
 
-  system("xauth add \"${display}\" . \"${mcookie}\"");
+  if (system("xauth add \"${display}\" . \"${mcookie}\"") == -1) {
+    die "system call to xauth failed: $!";
+  }
   if ($? != 0) {
     $self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started (xauth: $!)";
     $main::lxdebug->leave_sub();
@@ -646,10 +982,12 @@ sub convert_to_pdf {
   }
 
   if (!$::lx_office_conf{print_templates}->{openofficeorg_daemon}) {
-    system($::lx_office_conf{applications}->{openofficeorg_writer},
-           "-minimized", "-norestore", "-nologo", "-nolockcheck", "-headless",
-           "file:${filename}.odt",
-           "macro://" . (split('/', $filename))[-1] . "/Standard.Conversion.ConvertSelfToPDF()");
+    if (system($::lx_office_conf{applications}->{openofficeorg_writer},
+               "-minimized", "-norestore", "-nologo", "-nolockcheck", "-headless",
+               "file:${filename}.odt",
+               "macro://" . (split('/', $filename))[-1] . "/Standard.Conversion.ConvertSelfToPDF()") == -1) {
+      die "system call to $::lx_office_conf{applications}->{openofficeorg_writer} failed: $!";
+    }
   } else {
     if (!$self->spawn_openoffice()) {
       $main::lxdebug->leave_sub();