summaryrefslogtreecommitdiff
path: root/LedgerSMB/Form.pm
diff options
context:
space:
mode:
Diffstat (limited to 'LedgerSMB/Form.pm')
-rw-r--r--LedgerSMB/Form.pm646
1 files changed, 0 insertions, 646 deletions
diff --git a/LedgerSMB/Form.pm b/LedgerSMB/Form.pm
index 823ece35..6a2ae3b3 100644
--- a/LedgerSMB/Form.pm
+++ b/LedgerSMB/Form.pm
@@ -631,652 +631,6 @@ sub get_my_emp_num {
$form->{'emp_num'} = $id;
}
-sub parse_template {
-
- my ( $self, $myconfig ) = @_;
-
- my ( $chars_per_line, $lines_on_first_page, $lines_on_second_page ) =
- ( 0, 0, 0 );
- my ( $current_page, $current_line ) = ( 1, 1 );
- print STDERR "Using deprecated Form::parse_template function\n";
- my $pagebreak = "";
- my $sum = 0;
-
- my $subdir = "";
- my $err = "";
-
- my %include = ();
- my $ok;
- $self->{images} = "${LedgerSMB::Sysconfig::images}/$self->{templates}";
-
- if ( $self->{language_code} ) {
- if ( $self->{language_code} =~ /(\.\.|\/|\*)/ ) {
- $self->error("Invalid Language Code");
- }
-
- if ( -f "$self->{templates}/$self->{language_code}/$self->{IN}" ) {
- open( IN, '<',
- "$self->{templates}/$self->{language_code}/$self->{IN}" )
- or $self->error("$self->{IN} : $!");
- }
- else {
- open( IN, '<', "$self->{templates}/$self->{IN}" )
- or $self->error("$self->{IN} : $!");
- }
-
- }
- else {
- open( IN, '<', "$self->{templates}/$self->{IN}" )
- or $self->error("$self->{IN} : $!");
- }
-
- @_ = <IN>;
- close(IN);
-
- $self->{copies} = 1 if ( ( $self->{copies} *= 1 ) <= 0 );
-
- # OUT is used for the media, screen, printer, email
- # for postscript we store a copy in a temporary file
- my $fileid = time;
- my $tmpfile = $self->{IN};
- $tmpfile =~ s/\./_$self->{fileid}./ if $self->{fileid};
- $self->{tmpfile} = "${LedgerSMB::Sysconfig::tempdir}/${fileid}_${tmpfile}";
-
- my $temphash;
- if ( $self->{format} =~ /(postscript|pdf)/ || $self->{media} eq 'email' ) {
- $temphash{out} = $self->{OUT};
- $self->{OUT} = "$self->{tmpfile}";
- File::Copy::copy(
- "$self->{templates}/logo.png",
- "${LedgerSMB::Sysconfig::tempdir}/"
- );
- File::Copy::copy(
- "$self->{templates}/logo.eps",
- "${LedgerSMB::Sysconfig::tempdir}/"
- );
- $temphash{printmode} = $self->{printmode};
- $self->{printmode} = '>';
- }
-
- if ( $self->{OUT} ) {
- open( OUT, $self->{printmode}, "$self->{OUT}" )
- or $self->error("$self->{OUT} : $!");
- chmod( 0600, "$self->{OUT}" );
-
- }
- else {
- open( OUT, ">-" ) or $self->error("STDOUT : $!");
- $self->header;
- }
-
- # first we generate a tmpfile
- # read file and replace <?lsmb variable ?>
- while ( $_ = shift ) {
-
- $par = "";
- $var = $_;
-
- # detect pagebreak block and its parameters
- if (/<\?lsmb pagebreak ([0-9]+) ([0-9]+) ([0-9]+) \?>/) {
- $chars_per_line = $1;
- $lines_on_first_page = $2;
- $lines_on_second_page = $3;
-
- while ( $_ = shift ) {
- last if (/<\?lsmb end pagebreak \?>/);
- $pagebreak .= $_;
- }
- }
-
- if (/<\?lsmb foreach /) {
-
- # this one we need for the count
- chomp $var;
- $var =~ s/.*?<\?lsmb foreach (.+?) \?>/$1/;
- while ( $_ = shift ) {
- last if (/<\?lsmb end $var \?>/);
-
- # store line in $par
- $par .= $_;
- }
-
- # display contents of $self->{number}[] array
- for $i ( 0 .. $#{ $self->{$var} } ) {
-
- if ( $var =~ /^(part|service)$/ ) {
- next if $self->{$var}[$i] eq 'NULL';
- }
-
- # Try to detect whether a manual page break is necessary
- # but only if there was a <?lsmb pagebreak ... ?> block before
-
- if ( $var eq 'number' || $var eq 'part' || $var eq 'service' ) {
-
- if ( $chars_per_line && defined $self->{$var} ) {
-
- my $line;
- my $lines = 0;
- my @d = qw(description);
- push @d, "itemnotes" if $self->{countitemnotes};
-
- foreach my $item (@d) {
-
- if ( $self->{$item}[$i] ) {
-
- foreach $line ( split /\r?\n/,
- $self->{$item}[$i] )
- {
- $lines++;
- $lines +=
- int( length($line) / $chars_per_line );
- }
- }
- }
-
- my $lpp;
-
- if ( $current_page == 1 ) {
- $lpp = $lines_on_first_page;
- }
- else {
- $lpp = $lines_on_second_page;
- }
-
- # Yes we need a manual page break
- if ( ( $current_line + $lines ) > $lpp ) {
- my $pb = $pagebreak;
-
- # replace the special variables <?lsmb sumcarriedforward ?>
- # and <?lsmb lastpage ?>
- my $psum =
- $self->format_amount( $myconfig, $sum, 2 );
- $pb =~ s/<\?lsmb sumcarriedforward \?>/$psum/g;
- $pb =~ s/<\?lsmb lastpage \?>/$current_page/g;
-
- # only "normal" variables are supported here
- # (no <?lsmb if, no <?lsmb foreach, no <?lsmb include)
- $pb =~ s/<\?lsmb (.+?) \?>/$self->{$1}/g;
-
- # page break block is ready to rock
- print( OUT $pb );
- $current_page++;
- $current_line = 1;
- $lines = 0;
- }
-
- $current_line += $lines;
- }
-
- $sum +=
- $self->parse_amount( $myconfig, $self->{linetotal}[$i] );
- }
-
- # don't parse par, we need it for each line
- print OUT $self->format_line( $par, $i );
- }
- next;
- }
-
- # if not comes before if!
- if (/<\?lsmb if not /) {
-
- # check if it is not set and display
- chop;
- s/.*?<\?lsmb if not (.+?) \?>/$1/;
-
- if ( !$self->{$_} ) {
-
- while ( $_ = shift ) {
- last if (/<\?lsmb end /);
-
- # store line in $par
- $par .= $_;
- }
-
- $_ = $par;
-
- }
- else {
-
- while ( $_ = shift ) {
- last if (/<\?lsmb end /);
- }
-
- next;
- }
- }
-
- if (/<\?lsmb if /) {
-
- # check if it is set and display
- chop;
- s/.*?<\?lsmb if (.+?) \?>/$1/;
-
- # commenting this out for security reasons. If needed,
- # please uncomment. Functionality below will be in 1.3
- # Chris Travers
- #if (/\s/) {
- # @args = split;
- # if ($args[1] !~ /^(==|eq|>|gt|>|lt|>=|ge|le|<=|ne|!=)$/){
- # $self->error("Unknown/forbidden operator");
- # }
- # $ok = eval "$self->{$args[0]} $args[1] $args[2]";
- #} else {
- $ok = $self->{$_};
-
- #}
-
- if ($ok) {
- while ( $_ = shift ) {
- last if (/<\?lsmb end /);
-
- # store line in $par
- $par .= $_;
- }
-
- $_ = $par;
-
- }
- else {
-
- while ( $_ = shift ) {
- last if (/<\?lsmb end /);
- }
-
- next;
- }
- }
-
- # check for <?lsmb include filename ?>
- if (/<\?lsmb include /) {
-
- # get the filename
- chomp $var;
- $var =~ s/.*?<\?lsmb include (.+?) \?>/$1/;
-
- # remove / .. for security reasons
- $var =~ s/(\/|\.\.)//g;
-
- # assume loop after 10 includes of the same file
- next if ( $include{$var} > 10 );
-
- unless (
- open( INC, '<', "$self->{templates}/$self->{language_code}/$var"
- )
- )
- {
- $err = $!;
- $self->cleanup;
- $self->error(
- "$self->{templates}/$self->{language_code}/$var : $err");
- }
-
- unshift( @_, <INC> );
- close(INC);
-
- $include{$var}++;
-
- next;
- }
-
- print OUT $self->format_line($_);
-
- }
-
- close(OUT);
-
- delete $self->{countitemnotes};
-
- # Convert the tex file to postscript
- if ( $self->{format} =~ /(postscript|pdf)/ ) {
-
- $self->{tmpdir} = "${LedgerSMB::Sysconfig::tempdir}";
-
- unless ( chdir( $self->{tmpdir} ) ) {
- $err = $!;
- $self->cleanup;
- $self->error("chdir : $self->{tmpdir} : $err");
- }
-
- $self->{tmpfile} =~ s/$self->{tmpdir}\///g;
-
- $self->{errfile} = $self->{tmpfile};
- $self->{errfile} =~ s/tex$/err/;
-
- my $r = 1;
- if ( $self->{format} eq 'postscript' ) {
-
- system(
-"latex --interaction=nonstopmode $self->{tmpfile} > $self->{errfile}"
- );
-
- while ( $self->rerun_latex ) {
- system(
-"latex --interaction=nonstopmode $self->{tmpfile} > $self->{errfile}"
- );
- last if ++$r > 4;
- }
-
- $self->{tmpfile} =~ s/tex$/dvi/;
- $self->error( $self->cleanup ) if !( -f $self->{tmpfile} );
-
- system("dvips $self->{tmpfile} -o -q");
- $self->error( $self->cleanup . "dvips : $!" ) if ($?);
- $self->{tmpfile} =~ s/dvi$/ps/;
- }
-
- if ( $self->{format} eq 'pdf' ) {
- system(
-"pdflatex --interaction=nonstopmode $self->{tmpfile} > $self->{errfile}"
- );
-
- while ( $self->rerun_latex ) {
- system(
-"pdflatex --interaction=nonstopmode $self->{tmpfile} > $self->{errfile}"
- );
- last if ++$r > 4;
- }
-
- $self->{tmpfile} =~ s/tex$/pdf/;
- $self->error( $self->cleanup ) if !( -f $self->{tmpfile} );
- }
- }
-
- if ( $self->{format} =~ /(postscript|pdf)/ || $self->{media} eq 'email' ) {
-
- if ( $self->{media} eq 'email' ) {
-
- my $mail = new Mailer;
-
- for (qw(cc bcc subject message version format charset)) {
- $mail->{$_} = $self->{$_};
- }
-
- $mail->{to} = qq|$self->{email}|;
- $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|;
- $mail->{notify} = $self->{notify};
- $mail->{fileid} = "$fileid.";
-
- # if we send html or plain text inline
- if ( ( $self->{format} =~ /(html|txt)/ )
- && ( $self->{sendmode} eq 'inline' ) )
- {
-
- my $br = "";
- $br = "<br>" if $self->{format} eq 'html';
-
- $mail->{contenttype} = "text/$self->{format}";
-
- $mail->{message} =~ s/\r?\n/$br\n/g;
- $myconfig->{signature} =~ s/\\n/$br\n/g;
- $mail->{message} .= "$br\n-- $br\n$myconfig->{signature}\n$br"
- if $myconfig->{signature};
-
- unless ( open( IN, '<', $self->{tmpfile} ) ) {
- $err = $!;
- $self->cleanup;
- $self->error("$self->{tmpfile} : $err");
- }
-
- while (<IN>) {
- $mail->{message} .= $_;
- }
-
- close(IN);
-
- }
- else {
-
- @{ $mail->{attachments} } = ( $self->{tmpfile} );
-
- $myconfig->{signature} =~ s/\\n/\n/g;
- $mail->{message} .= "\n-- \n$myconfig->{signature}"
- if $myconfig->{signature};
-
- }
-
- if ( $err = $mail->send ) {
- $self->cleanup;
- $self->error($err);
- }
-
- }
- else {
-
- $self->{OUT} = $temphash{out};
- $self->{printmode} = $temphash{printmode} if $temphash{printmode};
-
- unless ( open( IN, '<', $self->{tmpfile} ) ) {
- $err = $!;
- $self->cleanup;
- $self->error("$self->{tmpfile} : $err");
- }
-
- binmode(IN);
-
- $self->{copies} = 1 if $self->{media} =~ /(screen|email|queue)/;
-
- chdir("$self->{cwd}");
-
- for my $i ( 1 .. $self->{copies} ) {
- if ( $self->{OUT} ) {
-
- unless ( open( OUT, $self->{printmode}, $self->{OUT} ) ) {
- $err = $!;
- $self->cleanup;
- $self->error("$self->{OUT} : $err");
- }
- chmod( 0600, "$self->{OUT}" );
-
- }
- else {
-
- # launch application
- print qq|Content-Type: application/$self->{format}\n|
- . qq|Content-Disposition: attachment; filename="$self->{tmpfile}"\n\n|;
-
- unless ( open( OUT, ">-" ) ) {
- $err = $!;
- $self->cleanup;
- $self->error("STDOUT : $err");
- }
- }
-
- binmode(OUT);
-
- while (<IN>) {
- print OUT $_;
- }
-
- close(OUT);
- seek IN, 0, 0;
- }
-
- close(IN);
- }
-
- $self->cleanup;
- }
-}
-
-sub format_line {
-
- my $self = shift;
-
- $_ = shift;
- my $i = shift;
-
- my $str;
- my $newstr;
- my $pos;
- my $l;
- my $lf;
- my $line;
- my $var = "";
- my %a;
- my $offset;
- my $pad;
- my $item;
-
- while (/<\?lsmb (.+?) \?>/) {
-
- %a = ();
-
- foreach $item ( split / /, $1 ) {
- my ( $key, $value ) = split /=/, $item;
-
- if ( $value ne "" ) {
- $a{$key} = $value;
- }
- else {
- $var = $item;
- }
- }
-
- $str = ( defined $i ) ? $self->{$var}[$i] : $self->{$var};
- $newstr = $str;
-
- $self->{countitemnotes} = 1 if $var eq 'itemnotes';
-
- $var = $1;
- if ( $var =~ /^if\s+not\s+/ ) {
-
- if ($str) {
-
- $var =~ s/if\s+not\s+//;
- s/<\?lsmb if\s+not\s+$var \?>.*?(<\?lsmb end\s+$var \?>|$)//s;
-
- }
- else {
- s/<\?lsmb $var \?>//;
- }
-
- next;
- }
-
- if ( $var =~ /^if\s+/ ) {
-
- if ($str) {
- s/<\?lsmb $var \?>//;
- }
- else {
- $var =~ s/if\s+//;
- s/<\?lsmb if\s+$var \?>.*?(<\?lsmb end\s+$var \?>|$)//s;
- }
-
- next;
- }
-
- if ( $var =~ /^end\s+/ ) {
- s/<\?lsmb $var \?>//;
- next;
- }
-
- if ( $a{align} || $a{width} || $a{offset} ) {
-
- $newstr = "";
- $offset = 0;
- $lf = "";
-
- foreach $str ( split /\n/, $str ) {
-
- $line = $str;
- $l = length $str;
-
- do {
-
- if ( ( $pos = length $str ) > $a{width} ) {
-
- if ( ( $pos = rindex $str, " ", $a{width} ) > 0 ) {
- $line = substr( $str, 0, $pos );
- }
-
- $pos = length $str if $pos == -1;
- }
-
- $l = length $line;
-
- # pad left, right or center
- $l = ( $a{width} - $l );
-
- $pad = " " x $l;
-
- if ( $a{align} =~ /right/i ) {
- $line = " " x $offset . $pad . $line;
- }
-
- if ( $a{align} =~ /left/i ) {
- $line = " " x $offset . $line . $pad;
- }
-
- if ( $a{align} =~ /center/i ) {
- $pad = " " x ( $l / 2 );
- $line = " " x $offset . $pad . $line;
- $pad = " " x ( $l / 2 );
- $line .= $pad;
- }
-
- $newstr .= "$lf$line";
-
- $str = substr( $str, $pos + 1 );
- $line = $str;
- $lf = "\n";
-
- $offset = $a{offset};
-
- } while ($str);
- }
- }
-
- s/<\?lsmb (.+?) \?>/$newstr/;
-
- }
-
- $_;
-}
-
-sub cleanup {
-
- my $self = shift;
-
- chdir("$self->{tmpdir}");
-
- my @err = ();
-
- if ( -f "$self->{errfile}" ) {
- open( FH, '<', "$self->{errfile}" );
- @err = <FH>;
- close(FH);
- }
-
- if ( $self->{tmpfile} ) {
-
- # strip extension
- $self->{tmpfile} =~ s/\.\w+$//g;
- my $tmpfile = $self->{tmpfile};
- unlink(<$tmpfile.*>);
- }
-
- chdir("$self->{cwd}");
-
- "@err";
-}
-
-sub rerun_latex {
-
- my $self = shift;
-
- my $a = 0;
-
- if ( -f "$self->{errfile}" ) {
- open( FH, '<', "$self->{errfile}" );
- $a = grep /(longtable Warning:|Warning:.*?LastPage)/, <FH>;
- close(FH);
- }
-
- $a;
-}
-
sub format_string {
my ( $self, @fields ) = @_;
generated by cgit v1.2.3 (git 2.46.0) at 2024-11-05 00:48:08 +0000