summaryrefslogtreecommitdiff
path: root/doc/george/user-id-configuration
diff options
context:
space:
mode:
Diffstat (limited to 'doc/george/user-id-configuration')
0 files changed, 0 insertions, 0 deletions
ass="hl slc">#
  • # Contributors: Thomas Bayen <bayen@gmx.de>
  • # Antti Kaihola <akaihola@siba.fi>
  • # Moritz Bunkus (tex)
  • # Jim Rawlings <jim@your-dba.com> (DB2)
  • #======================================================================
  • #
  • # This file has undergone whitespace cleanup.
  • #
  • #======================================================================
  • #
  • # main package
  • #
  • #======================================================================
  • use Math::BigFloat lib=>'GMP';
  • use LedgerSMB::Sysconfig;
  • package Form;
  • sub new {
  • my $type = shift;
  • my $argstr = shift;
  • read(STDIN, $_, $ENV{CONTENT_LENGTH});
  • if ($argstr){
  • $_ = $argstr;
  • }
  • elsif ($ENV{QUERY_STRING}) {
  • $_ = $ENV{QUERY_STRING};
  • }
  • elsif ($ARGV[0]) {
  • $_ = $ARGV[0];
  • }
  • my $self = {};
  • %$self = split /[&=]/;
  • for (keys %$self) { $self->{$_} = unescape("", $self->{$_}) }
  • if (substr($self->{action}, 0, 1) !~ /( |\.)/) {
  • $self->{action} = lc $self->{action};
  • $self->{action} =~ s/( |-|,|\#|\/|\.$)/_/g;
  • }
  • $self->{menubar} = 1 if $self->{path} =~ /lynx/i;
  • #menubar will be deprecated, replaced with below
  • $self->{lynx} = 1 if $self->{path} =~ /lynx/i;
  • $self->{version} = "1.2.0 Release Candidate 1";
  • $self->{dbversion} = "1.2.0";
  • bless $self, $type;
  • }
  • sub debug {
  • my ($self, $file) = @_;
  • if ($file) {
  • open(FH, '>', "$file") or die $!;
  • for (sort keys %$self) { print FH "$_ = $self->{$_}\n" }
  • close(FH);
  • } else {
  • print "\n";
  • for (sort keys %$self) { print "$_ = $self->{$_}\n" }
  • }
  • }
  • sub encode_all {
  • # TODO;
  • }
  • sub decode_all {
  • # TODO
  • }
  • sub escape {
  • my ($self, $str, $beenthere) = @_;
  • # for Apache 2 we escape strings twice
  • if (($ENV{SERVER_SIGNATURE} =~ /Apache\/2\.(\d+)\.(\d+)/) && !$beenthere) {
  • $str = $self->escape($str, 1) if $1 == 0 && $2 < 44;
  • }
  • $str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02x", ord($1))/ge;
  • $str;
  • }
  • sub unescape {
  • my ($self, $str) = @_;
  • $str =~ tr/+/ /;
  • $str =~ s/\\$//;
  • $str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg;
  • $str =~ s/\r?\n/\n/g;
  • $str;
  • }
  • sub quote {
  • my ($self, $str) = @_;
  • if ($str && ! ref($str)) {
  • $str =~ s/"/&quot;/g;
  • }
  • $str;
  • }
  • sub unquote {
  • my ($self, $str) = @_;
  • if ($str && ! ref($str)) {
  • $str =~ s/&quot;/"/g;
  • }
  • $str;
  • }
  • sub hide_form {
  • my $self = shift;
  • if (@_) {
  • for (@_) {
  • print qq|<input type="hidden" name="$_" value="|.$self->quote($self->{$_}).qq|" />\n|
  • }
  • } else {
  • delete $self->{header};
  • for (sort keys %$self) {
  • print qq|<input type="hidden" name="$_" value="|.$self->quote($self->{$_}).qq|" />\n|
  • }
  • }
  • }
  • sub error {
  • my ($self, $msg) = @_;
  • if ($ENV{HTTP_USER_AGENT}) {
  • $self->{msg} = $msg;
  • $self->{format} = "html";
  • $self->format_string('msg');
  • delete $self->{pre};
  • if (!$self->{header}) {
  • $self->header;
  • }
  • print qq|<body><h2 class="error">Error!</h2> <p><b>$self->{msg}</b></body>|;
  • exit;
  • } else {
  • if ($ENV{error_function}) {
  • &{ $ENV{error_function} }($msg);
  • } else {
  • die "Error: $msg\n";
  • }
  • }
  • }
  • sub info {
  • my ($self, $msg) = @_;
  • if ($ENV{HTTP_USER_AGENT}) {
  • $msg =~ s/\n/<br>/g;
  • delete $self->{pre};
  • if (!$self->{header}) {
  • $self->header;
  • print qq| <body>|;
  • $self->{header} = 1;
  • }
  • print "<b>$msg</b>";
  • } else {
  • if ($ENV{info_function}) {
  • &{ $ENV{info_function} }($msg);
  • } else {
  • print "$msg\n";
  • }
  • }
  • }
  • sub numtextrows {
  • my ($self, $str, $cols, $maxrows) = @_;
  • my $rows = 0;
  • for (split /\n/, $str) {
  • $rows += int (((length) - 2)/$cols) + 1
  • }
  • $maxrows = $rows unless defined $maxrows;
  • return ($rows > $maxrows) ? $maxrows : $rows;
  • }
  • sub dberror {
  • my ($self, $msg) = @_;
  • $self->error("$msg\n".$DBI::errstr);
  • }
  • sub isblank {
  • my ($self, $name, $msg) = @_;
  • $self->error($msg) if $self->{$name} =~ /^\s*$/;
  • }
  • sub header {
  • my ($self, $init, $headeradd) = @_;
  • return if $self->{header};
  • my ($stylesheet, $favicon, $charset);
  • if ($ENV{HTTP_USER_AGENT}) {
  • if ($self->{stylesheet} && (-f "css/$self->{stylesheet}")) {
  • $stylesheet = qq|<link rel="stylesheet" href="css/$self->{stylesheet}" type="text/css" title="LedgerSMB stylesheet" />\n|;
  • }
  • if ($self->{charset}) {
  • $charset = qq|<meta http-equiv="content-type" content="text/html; charset=$self->{charset}" />\n|;
  • }
  • $self->{titlebar} = ($self->{title}) ? "$self->{title} - $self->{titlebar}" : $self->{titlebar};
  • print qq|Content-Type: text/html\n\n
  • <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
  • "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
  • <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
  • <head>
  • <title>$self->{titlebar}</title>
  • <meta http-equiv="Pragma" content="no-cache" />
  • <meta http-equiv="Expires" content="-1" />
  • <link rel="shortcut icon" href="favicon.ico" type="image/x-icon" />
  • $stylesheet
  • $charset
  • <meta name="robots" content="noindex,nofollow" />
  • $headeradd
  • </head>
  • $self->{pre} \n|;
  • }
  • $self->{header} = 1;
  • }
  • sub redirect {
  • my ($self, $msg) = @_;
  • use List::Util qw(first);
  • if ($self->{callback} || !$msg){
  • main::redirect();
  • } else {
  • $self->info($msg);
  • }
  • }
  • sub sort_columns {
  • my ($self, @columns) = @_;
  • if ($self->{sort}) {
  • if (@columns) {
  • @columns = grep !/^$self->{sort}$/, @columns;
  • splice @columns, 0, 0, $self->{sort};
  • }
  • }
  • @columns;
  • }
  • sub sort_order {
  • my ($self, $columns, $ordinal) = @_;
  • # setup direction
  • if ($self->{direction}) {
  • if ($self->{sort} eq $self->{oldsort}) {
  • if ($self->{direction} eq 'ASC') {
  • $self->{direction} = "DESC";
  • } else {
  • $self->{direction} = "ASC";
  • }
  • }
  • } else {
  • $self->{direction} = "ASC";
  • }
  • $self->{oldsort} = $self->{sort};
  • my @a = $self->sort_columns(@{$columns});
  • if (%$ordinal) {
  • $a[0] = ($ordinal->{$a[$_]}) ? "$ordinal->{$a[0]} $self->{direction}" : "$a[0] $self->{direction}";
  • for (1 .. $#a) {
  • $a[$_] = $ordinal->{$a[$_]} if $ordinal->{$a[$_]}
  • }
  • } else {
  • $a[0] .= " $self->{direction}";
  • }
  • $sortorder = join ',', @a;
  • $sortorder;
  • }
  • sub format_amount {
  • my ($self, $myconfig, $amount, $places, $dash) = @_;
  • my $negative ;
  • if ($amount){
  • $amount = $self->parse_amount($myconfig, $amount);
  • $negative = ($amount < 0);
  • $amount =~ s/-//;
  • }
  • if ($places =~ /\d+/) {
  • #$places = 4 if $places == 2;
  • $amount = $self->round_amount($amount, $places);
  • }
  • # is the amount negative
  • # Parse $myconfig->{numberformat}
  • my ($ts, $ds) = ($1, $2);
  • if ($amount) {
  • if ($myconfig->{numberformat}) {
  • my ($whole, $dec) = split /\./, "$amount";
  • $amount = join '', reverse split //, $whole;
  • if ($places) {
  • $dec .= "0" x $places;
  • $dec = substr($dec, 0, $places);
  • }
  • if ($myconfig->{numberformat} eq '1,000.00') {
  • $amount =~ s/\d{3,}?/$&,/g;
  • $amount =~ s/,$//;
  • $amount = join '', reverse split //, $amount;
  • $amount .= "\.$dec" if ($dec ne "");
  • }
  • if ($myconfig->{numberformat} eq '1 000.00') {
  • $amount =~ s/\d{3,}?/$& /g;
  • $amount =~ s/\s$//;
  • $amount = join '', reverse split //, $amount;
  • $amount .= "\.$dec" if ($dec ne "");
  • }
  • if ($myconfig->{numberformat} eq "1'000.00") {
  • $amount =~ s/\d{3,}?/$&'/g;
  • $amount =~ s/'$//;
  • $amount = join '', reverse split //, $amount;
  • $amount .= "\.$dec" if ($dec ne "");
  • }
  • if ($myconfig->{numberformat} eq '1.000,00') {
  • $amount =~ s/\d{3,}?/$&./g;
  • $amount =~ s/\.$//;
  • $amount = join '', reverse split //, $amount;
  • $amount .= ",$dec" if ($dec ne "");
  • }
  • if ($myconfig->{numberformat} eq '1000,00') {
  • $amount = "$whole";
  • $amount .= ",$dec" if ($dec ne "");
  • }
  • if ($myconfig->{numberformat} eq '1000.00') {
  • $amount = "$whole";
  • $amount .= ".$dec" if ($dec ne "");
  • }
  • if ($dash =~ /-/) {
  • $amount = ($negative) ? "($amount)" : "$amount";
  • } elsif ($dash =~ /DRCR/) {
  • $amount = ($negative) ? "$amount DR" : "$amount CR";
  • } else {
  • $amount = ($negative) ? "-$amount" : "$amount";
  • }
  • }
  • } else {
  • if ($dash eq "0" && $places) {
  • if ($myconfig->{numberformat} eq '1.000,00') {
  • $amount = "0".","."0" x $places;
  • } else {
  • $amount = "0"."."."0" x $places;
  • }
  • } else {
  • $amount = ($dash ne "") ? "$dash" : "";
  • }
  • }
  • $amount;
  • }
  • sub parse_amount {
  • my ($self, $myconfig, $amount) = @_;
  • if (($amount eq '') or ($amount eq undef)) {
  • $amount = 0;
  • }
  • if (UNIVERSAL::isa($amount, 'Math::BigFloat')){ # Amount may not be an object
  • return $amount;
  • }
  • my $numberformat = $myconfig->{numberformat};
  • if (($numberformat eq '1.000,00') ||
  • ($numberformat eq '1000,00')) {
  • $amount =~ s/\.//g;
  • $amount =~ s/,/./;
  • }
  • if ($numberformat eq '1 000.00'){
  • $amount =~ s/\s//g;
  • }
  • if ($numberformat eq "1'000.00") {
  • $amount =~ s/'//g;
  • }
  • $amount =~ s/,//g;
  • if ($amount =~ s/\((\d*\.?\d*)\)/$1/){
  • $amount = $1 * -1;
  • }
  • if ($amount =~ s/(\d*\.?\d*)\s?DR/$1/){
  • $amount = $1 * -1;
  • }
  • $amount =~ s/\s?CR//;
  • $amount = new Math::BigFloat($amount);
  • return ($amount * 1);
  • }
  • sub round_amount {
  • my ($self, $amount, $places) = @_;
  • # These rounding rules follow from the previous implementation.
  • # They should be changed to allow different rules for different accounts.
  • Math::BigFloat->round_mode('+inf') if $amount >= 0;
  • Math::BigFloat->round_mode('-inf') if $amount < 0;
  • $amount = Math::BigFloat->new($amount)->ffround(-$places) if $places >= 0;
  • $amount = Math::BigFloat->new($amount)->ffround(-($places-1)) if $places < 0;
  • return $amount;
  • }
  • sub callproc {
  • my $procname = shift @_;
  • my $argstr = "";
  • my @results;
  • for (1 .. $#_){
  • $argstr .= "?, ";
  • }
  • $argstr =~ s/\, $//;
  • $query = "SELECT $procname";
  • $query =~ s/\(\)/$argstr/;
  • my $sth = $self->{dbh}->prepare($query);
  • while (my $ref = $sth->fetchrow_hashref(NAME_lc)){
  • push @results, $ref;
  • }
  • @results;
  • }
  • sub get_my_emp_num {
  • my ($self, $myconfig, $form) = @_;
  • %myconfig = %{$myconfig};
  • my $dbh = $form->{dbh};
  • # we got a connection, check the version
  • my $query = qq|
  • SELECT employeenumber FROM employee
  • WHERE login = ?|;
  • my $sth = $dbh->prepare($query);
  • $sth->execute($form->{login}) || $form->dberror($query);
  • $sth->execute;
  • my ($id) = $sth->fetchrow_array;
  • $sth->finish;
  • $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);
  • my $pagebreak = "";
  • my $sum = 0;
  • my $subdir = "";
  • my $err = "";
  • my %include = ();
  • my $ok;
  • 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::userspath}/${fileid}_${tmpfile}";
  • my $temphash;
  • if ($self->{format} =~ /(postscript|pdf)/ || $self->{media} eq 'email') {
  • $temphash{out} = $self->{OUT};
  • $self->{OUT} = "$self->{tmpfile}";
  • $temphash{printmode} = $self->{printmode};
  • $self->{printmode} = '>';
  • }
  • if ($self->{OUT}) {
  • open(OUT, $self->{printmode}, "$self->{OUT}") or $self->error("$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/;
  • if (/\s/) {
  • @a = split;
  • $ok = eval "$self->{$a[0]} $a[1] $a[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)/) {
  • use Cwd;
  • $self->{cwd} = cwd();
  • $self->{tmpdir} = "$self->{cwd}/${LedgerSMB::Sysconfig::userspath}";
  • $self->{tmpdir} = "${LedgerSMB::Sysconfig::userspath}" if
  • ${LedgerSMB::Sysconfig::userspath} =~ /^\//;
  • unless (chdir("${LedgerSMB::Sysconfig::userspath}")) {
  • $err = $!;
  • $self->cleanup;
  • $self->error("chdir : $err");
  • }
  • $self->{tmpfile} =~ s/${LedgerSMB::Sysconfig::userspath}\///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') {
  • use LedgerSMB::Mailer;
  • 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");
  • }
  • } 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;