diff options
-rw-r--r-- | LedgerSMB/Form.pm | 646 | ||||
-rw-r--r-- | t/10-form.t | 4 |
2 files changed, 0 insertions, 650 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 ) = @_; diff --git a/t/10-form.t b/t/10-form.t index 8940e2a6..bb374582 100644 --- a/t/10-form.t +++ b/t/10-form.t @@ -23,10 +23,6 @@ ##sub db_parse_numeric { ##sub callproc { ##sub get_my_emp_num { -##sub parse_template { -##sub format_line { -##sub cleanup { -##sub rerun_latex { ##sub format_string { ##sub db_init { ##sub run_custom_queries { |