Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision c510d88b

Von Sven Schöling vor mehr als 15 Jahren hinzugefügt

und die restlichen .pm Module.

Unterschiede anzeigen:

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