Revision c510d88b
Von Sven Schöling vor mehr als 15 Jahren hinzugefügt
SL/Auth/DB.pm | ||
---|---|---|
#use SL::Auth;
|
||
use SL::DBUtils;
|
||
|
||
use strict;
|
||
|
||
sub new {
|
||
$main::lxdebug->enter_sub();
|
||
|
||
... | ... | |
|
||
if (!$dbh) {
|
||
$main::lxdebug->leave_sub();
|
||
return SL::Auth::ERR_BACKEND;
|
||
return SL::Auth->ERR_BACKEND();
|
||
}
|
||
|
||
my $query = qq|SELECT password FROM auth."user" WHERE login = ?|;
|
||
... | ... | |
|
||
$main::lxdebug->leave_sub();
|
||
|
||
return $password eq $stored_password ? SL::Auth::OK : SL::Auth::ERR_PASSWORD;
|
||
return $password eq $stored_password ? SL::Auth->OK() : SL::Auth->ERR_PASSWORD();
|
||
}
|
||
|
||
sub can_change_password {
|
||
... | ... | |
|
||
if (!$dbh) {
|
||
$main::lxdebug->leave_sub();
|
||
return SL::Auth::ERR_BACKEND
|
||
return SL::Auth->ERR_BACKEND()
|
||
}
|
||
|
||
$password = crypt $password, substr($login, 0, 2) if (!$is_crypted);
|
SL/Auth/LDAP.pm | ||
---|---|---|
|
||
#use SL::Auth;
|
||
|
||
use strict;
|
||
|
||
sub new {
|
||
$main::lxdebug->enter_sub();
|
||
|
||
... | ... | |
|
||
if ($is_crypted) {
|
||
$main::lxdebug->leave_sub();
|
||
return SL::Auth::ERR_BACKEND;
|
||
return SL::Auth->ERR_BACKEND();
|
||
}
|
||
|
||
my $ldap = $self->_connect();
|
||
|
||
if (!$ldap) {
|
||
$main::lxdebug->leave_sub();
|
||
return SL::Auth::ERR_BACKEND;
|
||
return SL::Auth->ERR_BACKEND();
|
||
}
|
||
|
||
my $dn = $self->_get_user_dn($ldap, $login);
|
||
|
||
$main::lxdebug->message(LXDebug::DEBUG2, "LDAP authenticate: dn $dn");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), "LDAP authenticate: dn $dn");
|
||
|
||
if (!$dn) {
|
||
$main::lxdebug->leave_sub();
|
||
return SL::Auth::ERR_BACKEND;
|
||
return SL::Auth->ERR_BACKEND();
|
||
}
|
||
|
||
my $mesg = $ldap->bind($dn, 'password' => $password);
|
||
|
||
$main::lxdebug->message(LXDebug::DEBUG2, "LDAP authenticate: bind mesg " . $mesg->error());
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), "LDAP authenticate: bind mesg " . $mesg->error());
|
||
|
||
$main::lxdebug->leave_sub();
|
||
|
||
return $mesg->is_error() ? SL::Auth::ERR_PASSWORD : SL::Auth::OK;
|
||
return $mesg->is_error() ? SL::Auth->ERR_PASSWORD() : SL::Auth->OK();
|
||
}
|
||
|
||
sub can_change_password {
|
||
... | ... | |
}
|
||
|
||
sub change_password {
|
||
return SL::Auth::ERR_BACKEND;
|
||
return SL::Auth->ERR_BACKEND();
|
||
}
|
||
|
||
sub verify_config {
|
||
$main::lxdebug->enter_sub();
|
||
|
||
my $form = $main::form;
|
||
my $locale = $main::locale;
|
||
|
||
my $self = shift;
|
||
my $cfg = $self->{auth}->{LDAP_config};
|
||
|
SL/CT.pm | ||
---|---|---|
use SL::FU;
|
||
use SL::Notes;
|
||
|
||
use strict;
|
||
|
||
sub get_tuple {
|
||
$main::lxdebug->enter_sub();
|
||
|
SL/DATEV.pm | ||
---|---|---|
use File::Path;
|
||
use Time::HiRes qw(gettimeofday);
|
||
|
||
use strict;
|
||
|
||
sub _get_export_path {
|
||
$main::lxdebug->enter_sub();
|
||
|
||
... | ... | |
# connect to database
|
||
my $dbh = $form->dbconnect($myconfig);
|
||
|
||
$query = qq|SELECT * FROM datev|;
|
||
$sth = $dbh->prepare($query);
|
||
my $query = qq|SELECT * FROM datev|;
|
||
my $sth = $dbh->prepare($query);
|
||
$sth->execute || $form->dberror($query);
|
||
|
||
my $ref = $sth->fetchrow_hashref(NAME_lc);
|
||
my $ref = $sth->fetchrow_hashref("NAME_lc");
|
||
|
||
map { $form->{$_} = $ref->{$_} } keys %$ref;
|
||
|
||
... | ... | |
# connect to database
|
||
my $dbh = $form->dbconnect_noauto($myconfig);
|
||
|
||
$query = qq|DELETE FROM datev|;
|
||
my $query = qq|DELETE FROM datev|;
|
||
$dbh->do($query) || $form->dberror($query);
|
||
|
||
$query = qq|INSERT INTO datev
|
||
... | ... | |
. $dbh->quote($form->{mandantennr}) . qq|,|
|
||
. $dbh->quote($form->{datentraegernr}) . qq|,|
|
||
. $dbh->quote($form->{abrechnungsnr}) . qq|)|;
|
||
$sth = $dbh->prepare($query);
|
||
my $sth = $dbh->prepare($query);
|
||
$sth->execute || $form->dberror($query);
|
||
$sth->finish;
|
||
|
||
... | ... | |
$main::lxdebug->enter_sub();
|
||
|
||
my ($zeitraum, $monat, $quartal, $transdatefrom, $transdateto) = @_;
|
||
my ($fromto, $jahr, $leap);
|
||
|
||
my $form = $main::form;
|
||
|
||
$fromto = "transdate >= ";
|
||
|
||
... | ... | |
|
||
my $dbh = $form->get_standard_dbh($myconfig);
|
||
|
||
my ($notsplitindex);
|
||
my @errors = ();
|
||
|
||
$fromto =~ s/transdate/ac\.transdate/g;
|
||
... | ... | |
my $sth = prepare_execute_query($form, $dbh, $query);
|
||
|
||
my $counter = 0;
|
||
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
||
while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
|
||
$counter++;
|
||
if (($counter % 500) == 0) {
|
||
print("$counter ");
|
||
... | ... | |
my $firstrun = 1;
|
||
|
||
while (abs($count) > 0.01 || $firstrun) {
|
||
my $ref2 = $sth->fetchrow_hashref(NAME_lc);
|
||
my $ref2 = $sth->fetchrow_hashref("NAME_lc");
|
||
last unless ($ref2);
|
||
|
||
if ($ref2->{trans_id} != $trans->[0]->{trans_id}) {
|
||
... | ... | |
|
||
my $idx = 0;
|
||
my $correction = 0;
|
||
our @taxed; # most likely defunct
|
||
while (abs($absumsatz) >= 0.01) {
|
||
if ($idx >= scalar @taxed) {
|
||
last if (!$correction);
|
||
... | ... | |
$main::lxdebug->enter_sub();
|
||
|
||
my ($myconfig, $form, $fromto, $start_jahr) = @_;
|
||
my ($primanota);
|
||
|
||
my $jahr = $start_jahr;
|
||
if (!$jahr) {
|
||
... | ... | |
|
||
my ($date, $six) = @_;
|
||
|
||
($day, $month, $year) = split(/\./, $date);
|
||
my ($day, $month, $year) = split(/\./, $date);
|
||
|
||
if ($day =~ /^0/) {
|
||
$day = substr($day, 1, 1);
|
||
... | ... | |
if ($fromto ne "") {
|
||
$versionset .= "0000" . substr($header, 28, 19);
|
||
} else {
|
||
$datum = " " x 16;
|
||
my $datum = " " x 16;
|
||
$versionset .= $datum . "001" . substr($header, 28, 4);
|
||
}
|
||
|
||
... | ... | |
my $export_path = _get_export_path() . "/";
|
||
my $filename = "ED00000";
|
||
my $evfile = "EV01";
|
||
my @ed_versionsets;
|
||
my @ed_versionset;
|
||
my $fileno = 0;
|
||
|
||
$form->header;
|
||
... | ... | |
Buchungssätze verarbeitet:
|
||
|;
|
||
|
||
($fromto, $start_jahr) =
|
||
my ($fromto, $start_jahr) =
|
||
&get_dates($form->{zeitraum}, $form->{monat},
|
||
$form->{quartal}, $form->{transdatefrom},
|
||
$form->{transdateto});
|
||
... | ... | |
$filename++;
|
||
my $ed_filename = $export_path . $filename;
|
||
push(@filenames, $filename);
|
||
$header = &make_kne_data_header($myconfig, $form, $fromto, $start_jahr);
|
||
my $header = &make_kne_data_header($myconfig, $form, $fromto, $start_jahr);
|
||
|
||
my $kne_file = SL::DATEV::KNEFile->new();
|
||
$kne_file->add_block($header);
|
||
|
||
while (scalar(@{ $form->{DATEV} }) > 0) {
|
||
$transaction = shift @{ $form->{DATEV} };
|
||
$trans_lines = scalar(@{$transaction});
|
||
my $transaction = shift @{ $form->{DATEV} };
|
||
my $trans_lines = scalar(@{$transaction});
|
||
$counter++;
|
||
if (($counter % 500) == 0) {
|
||
print("$counter ");
|
||
... | ... | |
my $datevautomatik = 0;
|
||
my $taxkey = 0;
|
||
my $charttax = 0;
|
||
my ($haben, $soll);
|
||
my $iconv = $main::locale->{iconv_iso8859};
|
||
my %umlaute = ($iconv->convert('?') => 'ae',
|
||
$iconv->convert('?') => 'oe',
|
||
... | ... | |
}
|
||
|
||
# Umwandlung von Umlauten und Sonderzeichen in erlaubte Zeichen bei Textfeldern
|
||
foreach $umlaut (keys(%umlaute)) {
|
||
foreach my $umlaut (keys(%umlaute)) {
|
||
$transaction->[$haben]->{'invnumber'} =~ s/${umlaut}/${umlaute{$umlaut}}/g;
|
||
$transaction->[$haben]->{'name'} =~ s/${umlaut}/${umlaute{$umlaut}}/g;
|
||
}
|
||
... | ... | |
}
|
||
|
||
#Make EV Verwaltungsdatei
|
||
$ev_header = &make_ev_header($form, $fileno);
|
||
$ev_filename = $export_path . $evfile;
|
||
my $ev_header = &make_ev_header($form, $fileno);
|
||
my $ev_filename = $export_path . $evfile;
|
||
push(@filenames, $evfile);
|
||
open(EV, "> $ev_filename") or die "can't open outputfile: EV01\n";
|
||
print(EV $ev_header);
|
||
|
||
foreach $file (@ed_versionset) {
|
||
foreach my $file (@ed_versionset) {
|
||
print(EV $ed_versionset[$file]);
|
||
}
|
||
close(EV);
|
||
... | ... | |
my $export_path = _get_export_path() . "/";
|
||
my $filename = "ED00000";
|
||
my $evfile = "EV01";
|
||
my @ed_versionsets;
|
||
my @ed_versionset;
|
||
my $fileno = 1;
|
||
my $i = 0;
|
||
my $blockcount = 1;
|
||
... | ... | |
my $ed_filename = $export_path . $filename;
|
||
push(@filenames, $filename);
|
||
open(ED, "> $ed_filename") or die "can't open outputfile: $!\n";
|
||
$header = &make_kne_data_header($myconfig, $form, "");
|
||
my $header = &make_kne_data_header($myconfig, $form, "");
|
||
$remaining_bytes -= length($header);
|
||
|
||
my $fuellzeichen;
|
||
our $fromto;
|
||
|
||
# connect to database
|
||
my $dbh = $form->dbconnect($myconfig);
|
||
|
||
... | ... | |
my $sth = $dbh->prepare($query);
|
||
$sth->execute(@values) || $form->dberror($query);
|
||
|
||
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
||
while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
|
||
if (($remaining_bytes - length("t" . $ref->{'accno'})) <= 6) {
|
||
$fuellzeichen = ($blockcount * 256 - length($buchungssatz . $header));
|
||
$buchungssatz .= "\x00" x $fuellzeichen;
|
||
... | ... | |
print(ED $header);
|
||
print(ED $buchungssatz);
|
||
$fuellzeichen = 256 - (length($header . $buchungssatz . "z") % 256);
|
||
$dateiende = "\x00" x $fuellzeichen;
|
||
my $dateiende = "\x00" x $fuellzeichen;
|
||
print(ED "z");
|
||
print(ED $dateiende);
|
||
close(ED);
|
||
... | ... | |
$ed_versionset[0] =
|
||
&make_ed_versionset($header, $filename, $blockcount, $fromto);
|
||
|
||
$ev_header = &make_ev_header($form, $fileno);
|
||
$ev_filename = $export_path . $evfile;
|
||
my $ev_header = &make_ev_header($form, $fileno);
|
||
my $ev_filename = $export_path . $evfile;
|
||
push(@filenames, $evfile);
|
||
open(EV, "> $ev_filename") or die "can't open outputfile: EV01\n";
|
||
print(EV $ev_header);
|
||
|
||
foreach $file (@ed_versionset) {
|
||
foreach my $file (@ed_versionset) {
|
||
print(EV $ed_versionset[$file]);
|
||
}
|
||
close(EV);
|
SL/DATEV/KNEFile.pm | ||
---|---|---|
package SL::DATEV::KNEFile;
|
||
|
||
use strict;
|
||
|
||
sub new {
|
||
my $type = shift;
|
||
my $self = {};
|
||
... | ... | |
my $self = shift;
|
||
my $amount = shift;
|
||
my $width = shift;
|
||
our $stellen;
|
||
|
||
$amount =~ s/-//;
|
||
my ($places, $decimal_places) = split m/\./, "$amount";
|
SL/FU.pm | ||
---|---|---|
use SL::DBUtils;
|
||
use SL::Notes;
|
||
|
||
use strict;
|
||
|
||
sub save {
|
||
$main::lxdebug->enter_sub();
|
||
|
SL/Form.pm | ||
---|---|---|
|
||
package Form;
|
||
|
||
#use strict;
|
||
|
||
use Data::Dumper;
|
||
|
||
use CGI;
|
||
... | ... | |
use List::Util qw(first max min sum);
|
||
use List::MoreUtils qw(any);
|
||
|
||
use strict;
|
||
|
||
my $standard_dbh;
|
||
|
||
END {
|
||
... | ... | |
_recode_recursively($iconv, $self);
|
||
}
|
||
|
||
delete $self{INPUT_ENCODING};
|
||
delete $self->{INPUT_ENCODING};
|
||
}
|
||
|
||
$self->{action} = lc $self->{action};
|
||
... | ... | |
my ($self, $myconfig) = @_;
|
||
|
||
if ($standard_dbh && !$standard_dbh->{Active}) {
|
||
$main::lxdebug->message(LXDebug::INFO, "get_standard_dbh: \$standard_dbh is defined but not Active anymore");
|
||
$main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$standard_dbh is defined but not Active anymore");
|
||
undef $standard_dbh;
|
||
}
|
||
|
SL/Iconv.pm | ||
---|---|---|
|
||
use vars qw(%converters);
|
||
|
||
use strict;
|
||
|
||
sub get_converter {
|
||
my ($from_charset, $to_charset) = @_;
|
||
|
SL/MIME.pm | ||
---|---|---|
package SL::MIME;
|
||
|
||
use strict;
|
||
|
||
sub mime_type_from_ext {
|
||
$main::lxdebug->enter_sub();
|
||
|
SL/Mailer.pm | ||
---|---|---|
use SL::MIME;
|
||
use SL::Template;
|
||
|
||
use strict;
|
||
|
||
my $num_sent = 0;
|
||
|
||
sub new {
|
SL/Num2text.pm | ||
---|---|---|
#
|
||
#=====================================================================
|
||
|
||
use strict;
|
||
|
||
sub init {
|
||
my $self = shift;
|
||
|
||
... | ... | |
|
||
# add thousand, million
|
||
if ($i) {
|
||
$num = 10**($i * 3);
|
||
my $num = 10**($i * 3);
|
||
push(@textnumber, $self->{numbername}{$num});
|
||
}
|
||
|
SL/OE.pm | ||
---|---|---|
use SL::DBUtils;
|
||
use SL::IC;
|
||
|
||
use strict;
|
||
|
||
=head1 NAME
|
||
|
||
OE.pm - Order entry module
|
SL/OP.pm | ||
---|---|---|
|
||
use SL::DBUtils;
|
||
|
||
use strict;
|
||
|
||
sub overpayment {
|
||
$main::lxdebug->enter_sub();
|
||
|
||
... | ... | |
do_query($form, $dbh, $query, @values);
|
||
|
||
# add AR/AP
|
||
($accno) = split /--/, $form->{ $form->{ARAP} };
|
||
my ($accno) = split /--/, $form->{ $form->{ARAP} };
|
||
|
||
$query =
|
||
qq|INSERT INTO acc_trans (trans_id, chart_id, transdate, amount) | .
|
SL/RP.pm | ||
---|---|---|
use SL::DBUtils;
|
||
use Data::Dumper;
|
||
use List::Util qw(sum);
|
||
# use strict;
|
||
# use warnings;
|
||
|
||
# use warnings;
|
||
use strict;
|
||
|
||
# new implementation of balance sheet
|
||
# readme!
|
||
... | ... | |
my $glwhere = "";
|
||
my $prwhere = "";
|
||
my $subwhere = "";
|
||
my $inwhere = "";
|
||
my $item;
|
||
|
||
if ($fromdate) {
|
||
... | ... | |
my $glwhere = '';
|
||
my $glsumwhere = '';
|
||
my $tofrom;
|
||
my ($fromdate, $todate);
|
||
|
||
if ($form->{fromdate} || $form->{todate}) {
|
||
if ($form->{fromdate}) {
|
SL/Template.pm | ||
---|---|---|
# Web http://www.lx-office.org
|
||
#
|
||
#====================================================================
|
||
#
|
||
#
|
||
# NOTE: strict checks are package global. don't check this file
|
||
# with perl -sc, it will only capture SimpleTemplate
|
||
#
|
||
#
|
||
|
||
package SimpleTemplate;
|
||
|
||
use strict;
|
||
|
||
# Parameters:
|
||
# 1. The template's file name
|
||
# 2. A reference to the Form object
|
||
... | ... | |
|
||
@ISA = qw(SimpleTemplate);
|
||
|
||
use strict;
|
||
|
||
sub new {
|
||
my $type = shift;
|
||
|
||
... | ... | |
|
||
@ISA = qw(LaTeXTemplate);
|
||
|
||
use strict;
|
||
|
||
sub new {
|
||
my $type = shift;
|
||
|
||
... | ... | |
|
||
@ISA = qw(LaTeXTemplate);
|
||
|
||
use strict;
|
||
|
||
sub new {
|
||
my $type = shift;
|
||
|
||
... | ... | |
|
||
@ISA = qw(SimpleTemplate);
|
||
|
||
use strict;
|
||
|
||
sub new {
|
||
my $type = shift;
|
||
|
||
$self = $type->SUPER::new(@_);
|
||
my $self = $type->SUPER::new(@_);
|
||
|
||
foreach my $module (qw(Archive::Zip Text::Iconv)) {
|
||
eval("use ${module};");
|
||
... | ... | |
}
|
||
|
||
my $zip = Archive::Zip->new();
|
||
if (Archive::Zip::AZ_OK != $zip->read($file_name)) {
|
||
if (Archive::Zip->AZ_OK != $zip->read($file_name)) {
|
||
$self->{"error"} = "File not found/is not a OpenDocument file.";
|
||
$main::lxdebug->leave_sub();
|
||
return 0;
|
||
... | ... | |
my $dfname = $self->{"userspath"} . "/xvfb_display";
|
||
my $display;
|
||
|
||
$main::lxdebug->message(LXDebug::DEBUG2, " Looking for $dfname\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), " Looking for $dfname\n");
|
||
if ((-f $dfname) && open(IN, $dfname)) {
|
||
my $pid = <IN>;
|
||
chomp($pid);
|
||
... | ... | |
chomp($xauthority);
|
||
close(IN);
|
||
|
||
$main::lxdebug->message(LXDebug::DEBUG2, " found with $pid and $display\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), " found with $pid and $display\n");
|
||
|
||
if ((! -d "/proc/$pid") || !open(IN, "/proc/$pid/cmdline")) {
|
||
$main::lxdebug->message(LXDebug::DEBUG2, " no/wrong process #1\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), " no/wrong process #1\n");
|
||
unlink($dfname, $xauthority);
|
||
$main::lxdebug->leave_sub();
|
||
return undef;
|
||
... | ... | |
my $line = <IN>;
|
||
close(IN);
|
||
if ($line !~ /xvfb/i) {
|
||
$main::lxdebug->message(LXDebug::DEBUG2, " no/wrong process #2\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), " no/wrong process #2\n");
|
||
unlink($dfname, $xauthority);
|
||
$main::lxdebug->leave_sub();
|
||
return undef;
|
||
... | ... | |
$ENV{"XAUTHORITY"} = $xauthority;
|
||
$ENV{"DISPLAY"} = $display;
|
||
} else {
|
||
$main::lxdebug->message(LXDebug::DEBUG2, " not found\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), " not found\n");
|
||
}
|
||
|
||
$main::lxdebug->leave_sub();
|
||
... | ... | |
|
||
my ($self) = @_;
|
||
|
||
$main::lxdebug->message(LXDebug::DEBUG2, "spawn_xvfb()\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2, "spawn_xvfb()\n");
|
||
|
||
my $display = $self->is_xvfb_running();
|
||
|
||
... | ... | |
$display++;
|
||
}
|
||
$display = ":${display}";
|
||
$main::lxdebug->message(LXDebug::DEBUG2, " display $display\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), " display $display\n");
|
||
|
||
my $mcookie = `mcookie`;
|
||
die("Installation error: mcookie not found.") if ($? != 0);
|
||
chomp($mcookie);
|
||
|
||
$main::lxdebug->message(LXDebug::DEBUG2, " mcookie $mcookie\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), " mcookie $mcookie\n");
|
||
|
||
my $xauthority = "/tmp/.Xauthority-" . $$ . "-" . time() . "-" . int(rand(9999999));
|
||
$ENV{"XAUTHORITY"} = $xauthority;
|
||
|
||
$main::lxdebug->message(LXDebug::DEBUG2, " xauthority $xauthority\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), " xauthority $xauthority\n");
|
||
|
||
system("xauth add \"${display}\" . \"${mcookie}\"");
|
||
if ($? != 0) {
|
||
... | ... | |
return undef;
|
||
}
|
||
|
||
$main::lxdebug->message(LXDebug::DEBUG2, " about to fork()\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), " about to fork()\n");
|
||
|
||
my $pid = fork();
|
||
if (0 == $pid) {
|
||
$main::lxdebug->message(LXDebug::DEBUG2, " Child execing\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), " Child execing\n");
|
||
exec($main::xvfb_bin, $display, "-screen", "0", "640x480x8", "-nolisten", "tcp");
|
||
}
|
||
sleep(3);
|
||
$main::lxdebug->message(LXDebug::DEBUG2, " parent dont sleeping\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), " parent dont sleeping\n");
|
||
|
||
local *OUT;
|
||
my $dfname = $self->{"userspath"} . "/xvfb_display";
|
||
... | ... | |
print(OUT "$pid\n$display\n$xauthority\n");
|
||
close(OUT);
|
||
|
||
$main::lxdebug->message(LXDebug::DEBUG2, " parent re-testing\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), " parent re-testing\n");
|
||
|
||
if (!$self->is_xvfb_running()) {
|
||
$self->{"error"} = "Conversion to PDF failed because OpenOffice could not be started.";
|
||
... | ... | |
return undef;
|
||
}
|
||
|
||
$main::lxdebug->message(LXDebug::DEBUG2, " spawn OK\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), " spawn OK\n");
|
||
|
||
$main::lxdebug->leave_sub();
|
||
|
||
... | ... | |
system("./scripts/oo-uno-test-conn.py $main::openofficeorg_daemon_port " .
|
||
"> /dev/null 2> /dev/null");
|
||
my $res = $? == 0;
|
||
$main::lxdebug->message(LXDebug::DEBUG2, " is_openoffice_running(): $?\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), " is_openoffice_running(): $?\n");
|
||
|
||
$main::lxdebug->leave_sub();
|
||
|
||
... | ... | |
|
||
my ($self) = @_;
|
||
|
||
$main::lxdebug->message(LXDebug::DEBUG2, "spawn_openoffice()\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), "spawn_openoffice()\n");
|
||
|
||
my ($try, $spawned_oo, $res);
|
||
|
||
... | ... | |
if (!$spawned_oo) {
|
||
my $pid = fork();
|
||
if (0 == $pid) {
|
||
$main::lxdebug->message(LXDebug::DEBUG2, " Child daemonizing\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), " Child daemonizing\n");
|
||
chdir('/');
|
||
open(STDIN, '/dev/null');
|
||
open(STDOUT, '>/dev/null');
|
||
my $new_pid = fork();
|
||
exit if ($new_pid);
|
||
my $ssres = setsid();
|
||
$main::lxdebug->message(LXDebug::DEBUG2, " Child execing\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), " Child execing\n");
|
||
my @cmdline = ($main::openofficeorg_writer_bin,
|
||
"-minimized", "-norestore", "-nologo", "-nolockcheck",
|
||
"-headless",
|
||
... | ... | |
exec(@cmdline);
|
||
}
|
||
|
||
$main::lxdebug->message(LXDebug::DEBUG2, " Parent after fork\n");
|
||
$main::lxdebug->message(LXDebug->DEBUG2(), " Parent after fork\n");
|
||
$spawned_oo = 1;
|
||
sleep(3);
|
||
}
|
||
... | ... | |
}
|
||
|
||
sub get_mime_type() {
|
||
my ($self) = @_;
|
||
|
||
if ($self->{"form"}->{"format"} =~ /pdf/) {
|
||
return "application/pdf";
|
||
} else {
|
||
... | ... | |
|
||
@ISA = qw(HTMLTemplate);
|
||
|
||
use strict;
|
||
|
||
sub new {
|
||
#evtl auskommentieren
|
||
my $type = shift;
|
SL/Template/Plugin/JavaScript.pm | ||
---|---|---|
use base qw( Template::Plugin );
|
||
use Template::Plugin;
|
||
|
||
use strict;
|
||
|
||
sub new {
|
||
my $class = shift;
|
||
my $context = shift;
|
SL/Template/Plugin/LxERP.pm | ||
---|---|---|
|
||
use SL::AM;
|
||
|
||
use strict;
|
||
|
||
sub new {
|
||
my $class = shift;
|
||
my $context = shift;
|
SL/Template/Plugin/MultiColumnIterator.pm | ||
---|---|---|
package SL::Template::Plugin::MultiColumnIterator;
|
||
|
||
#use strict;
|
||
use base 'Template::Plugin';
|
||
use Template::Constants;
|
||
use Template::Exception;
|
||
... | ... | |
use SL::LXDebug;
|
||
use Data::Dumper;
|
||
|
||
use strict;
|
||
|
||
our $AUTOLOAD;
|
||
|
||
sub new {
|
||
$main::lxdebug->enter_sub();
|
||
$main::lxdebug->enter_sub();
|
||
my $class = shift;
|
||
my $context = shift;
|
||
my $data = shift || [ ];
|
||
... | ... | |
$data = [ $data ] ;
|
||
}
|
||
|
||
$main::lxdebug->leave_sub();
|
||
$main::lxdebug->leave_sub();
|
||
|
||
bless {
|
||
_DATA => $data,
|
||
... | ... | |
|
||
|
||
sub get_first {
|
||
$main::lxdebug->enter_sub();
|
||
$main::lxdebug->enter_sub();
|
||
my $self = shift;
|
||
my $data = $self->{ _DATA };
|
||
my $dim = $self->{ _DIM };
|
||
... | ... | |
$self->{ _DATASET } = $self->{ _DATA };
|
||
my $size = int ((scalar @$data - 1) / $dim) + 1;
|
||
my $index = 0;
|
||
|
||
|
||
return (undef, Template::Constants::STATUS_DONE) unless $size;
|
||
|
||
# initialise various counters, flags, etc.
|
||
... | ... | |
@$self{ qw( PREV ) } = ( undef );
|
||
$$self{ qw( NEXT ) } = [ @{ $self->{ _DATASET } }[ map { $index + 1 + $_ * $size } 0 .. ($dim - 1) ] ];
|
||
|
||
$main::lxdebug->leave_sub();
|
||
$main::lxdebug->leave_sub();
|
||
return [ @{ $self->{ _DATASET } }[ map { $index + $_ * $size } 0 .. ($dim - 1) ] ];
|
||
}
|
||
|
||
sub get_next {
|
||
$main::lxdebug->enter_sub();
|
||
$main::lxdebug->enter_sub();
|
||
my $self = shift;
|
||
my ($max, $index) = @$self{ qw( MAX INDEX ) };
|
||
my $data = $self->{ _DATASET };
|
||
... | ... | |
@$self{ qw( INDEX COUNT FIRST LAST ) } = ( $index, $index + 1, 0, $index == $max ? 1 : 0 );
|
||
$$self{ qw( PREV ) } = [ @{ $self->{ _DATASET } }[ map { $index - 1 + $_ * $size } 0 .. ($dim - 1) ] ];
|
||
$$self{ qw( NEXT ) } = [ @{ $self->{ _DATASET } }[ map { $index + 1 + $_ * $size } 0 .. ($dim - 1) ] ];
|
||
$main::lxdebug->leave_sub();
|
||
$main::lxdebug->leave_sub();
|
||
return [ @{ $self->{ _DATASET } }[ map { $index + $_ * $size } 0 .. ($dim - 1) ] ];
|
||
}
|
||
else {
|
||
$main::lxdebug->leave_sub();
|
||
$main::lxdebug->leave_sub();
|
||
return (undef, Template::Constants::STATUS_DONE); ## RETURN ##
|
||
}
|
||
}
|
||
... | ... | |
}
|
||
|
||
sub dump {
|
||
$main::lxdebug->enter_sub();
|
||
$main::lxdebug->enter_sub();
|
||
my $self = shift;
|
||
$main::lxdebug->leave_sub();
|
||
$main::lxdebug->leave_sub();
|
||
return join('',
|
||
"<pre>",
|
||
" Data: ", Dumper($self->{ _DATA }), "\n",
|
||
... | ... | |
}
|
||
|
||
sub index {
|
||
$main::lxdebug->enter_sub();
|
||
$main::lxdebug->enter_sub();
|
||
my ($self) = @_;
|
||
$main::lxdebug->leave_sub();
|
||
$main::lxdebug->leave_sub();
|
||
return $self->{ INDEX };
|
||
}
|
||
|
||
sub number {
|
||
$main::lxdebug->enter_sub();
|
||
$main::lxdebug->enter_sub();
|
||
my ($self) = @_;
|
||
$main::lxdebug->leave_sub();
|
||
$main::lxdebug->leave_sub();
|
||
return $self->{ NUMBER };
|
||
}
|
||
|
||
sub count {
|
||
$main::lxdebug->enter_sub();
|
||
$main::lxdebug->enter_sub();
|
||
my ($self) = @_;
|
||
$main::lxdebug->leave_sub();
|
||
$main::lxdebug->leave_sub();
|
||
return $self->{ COUNT };
|
||
}
|
||
sub max {
|
||
$main::lxdebug->enter_sub();
|
||
$main::lxdebug->enter_sub();
|
||
my ($self) = @_;
|
||
$main::lxdebug->leave_sub();
|
||
$main::lxdebug->leave_sub();
|
||
return $self->{ MAX };
|
||
}
|
||
|
||
sub size {
|
||
$main::lxdebug->enter_sub();
|
||
$main::lxdebug->enter_sub();
|
||
my ($self) = @_;
|
||
$main::lxdebug->leave_sub();
|
||
$main::lxdebug->leave_sub();
|
||
return $self->{ SIZE };
|
||
}
|
||
|
||
sub first {
|
||
$main::lxdebug->enter_sub();
|
||
$main::lxdebug->enter_sub();
|
||
my ($self) = @_;
|
||
$main::lxdebug->leave_sub();
|
||
$main::lxdebug->leave_sub();
|
||
return $self->{ FIRST };
|
||
}
|
||
|
||
sub last {
|
||
$main::lxdebug->enter_sub();
|
||
$main::lxdebug->enter_sub();
|
||
my ($self) = @_;
|
||
$main::lxdebug->leave_sub();
|
||
$main::lxdebug->leave_sub();
|
||
return $self->{ LAST};
|
||
}
|
||
|
SL/WH.pm | ||
---|---|---|
use SL::AM;
|
||
use SL::DBUtils;
|
||
use SL::Form;
|
||
|
||
use warnings;
|
||
#use strict;
|
||
use strict;
|
||
|
||
sub transfer {
|
||
$main::lxdebug->enter_sub();
|
||
|
||
... | ... | |
my $dbh = $form->get_standard_dbh($myconfig);
|
||
|
||
# filters
|
||
my (@filter_ary, @filter_vars, $joins);
|
||
my (@filter_ary, @filter_vars, $joins, %select_tokens, %select);
|
||
|
||
if ($filter{warehouse_id} ne '') {
|
||
push @filter_ary, "w1.id = ? OR w2.id = ?";
|
||
... | ... | |
}
|
||
|
||
my @contents = ();
|
||
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
||
while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
|
||
map { /^r_/; $ref->{"$'"} = $ref->{$_} } keys %$ref;
|
||
my $qty = $ref->{"qty"} * 1;
|
||
|
||
... | ... | |
|
||
my (%non_empty_bins, @all_fields, @contents);
|
||
|
||
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
||
while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
|
||
$ref->{qty} *= 1;
|
||
my $qty = $ref->{qty};
|
||
|
Auch abrufbar als: Unified diff
und die restlichen .pm Module.