summaryrefslogtreecommitdiff
path: root/LedgerSMB
diff options
context:
space:
mode:
Diffstat (limited to 'LedgerSMB')
-rwxr-xr-xLedgerSMB/Inifile.pm69
-rwxr-xr-xLedgerSMB/Mailer.pm203
-rwxr-xr-xLedgerSMB/Menu.pm102
-rwxr-xr-xLedgerSMB/Num2text.pm120
4 files changed, 256 insertions, 238 deletions
diff --git a/LedgerSMB/Inifile.pm b/LedgerSMB/Inifile.pm
index dbc3ca37..9922c63c 100755
--- a/LedgerSMB/Inifile.pm
+++ b/LedgerSMB/Inifile.pm
@@ -24,7 +24,7 @@
#
#======================================================================
#
-# This file has NOT undergone whitespace cleanup.
+# This file has undergone whitespace cleanup.
#
#======================================================================
#
@@ -37,54 +37,55 @@ package Inifile;
sub new {
- my ($type, $file) = @_;
+ my ($type, $file) = @_;
- warn "$type has no copy constructor! creating a new object." if ref($type);
- $type = ref($type) || $type;
- my $self = bless {}, $type;
- $self->add_file($file) if defined $file;
+ warn "$type has no copy constructor! creating a new object."
+ if ref($type);
+ $type = ref($type) || $type;
+ my $self = bless {}, $type;
+ $self->add_file($file) if defined $file;
- return $self;
+ return $self;
}
sub add_file {
- my ($self, $file) = @_;
+ my ($self, $file) = @_;
- my $id = "";
- my %menuorder = ();
+ my $id = "";
+ my %menuorder = ();
- for (@{$self->{ORDER}}) { $menuorder{$_} = 1 }
+ for (@{$self->{ORDER}}) { $menuorder{$_} = 1 }
- open FH, "$file" or Form->error("$file : $!");
+ open FH, "$file" or Form->error("$file : $!");
- while (<FH>) {
- next if /^(#|;|\s)/;
- last if /^\./;
+ while (<FH>) {
+ next if /^(#|;|\s)/;
+ last if /^\./;
- chop;
+ chop;
- # strip comments
- s/\s*(#|;).*//g;
+ # strip comments
+ s/\s*(#|;).*//g;
- # remove any trailing whitespace
- s/^\s*(.*?)\s*$/$1/;
-
- if (/^\[/) {
- s/(\[|\])//g;
- $id = $_;
- push @{$self->{ORDER}}, $_ if ! $menuorder{$_};
- $menuorder{$_} = 1;
- next;
- }
-
- # add key=value to $id
- my ($key, $value) = split /=/, $_, 2;
+ # remove any trailing whitespace
+ s/^\s*(.*?)\s*$/$1/;
+
+ if (/^\[/) {
+ s/(\[|\])//g;
+ $id = $_;
+ push @{$self->{ORDER}}, $_ if ! $menuorder{$_};
+ $menuorder{$_} = 1;
+ next;
+ }
+
+ # add key=value to $id
+ my ($key, $value) = split /=/, $_, 2;
- $self->{$id}{$key} = $value;
+ $self->{$id}{$key} = $value;
- }
- close FH;
+ }
+ close FH;
}
diff --git a/LedgerSMB/Mailer.pm b/LedgerSMB/Mailer.pm
index 0d3d9c96..f541a3f5 100755
--- a/LedgerSMB/Mailer.pm
+++ b/LedgerSMB/Mailer.pm
@@ -36,106 +36,115 @@
package Mailer;
sub new {
- my ($type) = @_;
- my $self = {};
+ my ($type) = @_;
+ my $self = {};
- bless $self, $type;
+ bless $self, $type;
}
sub send {
- my ($self, $out) = @_;
+ my ($self, $out) = @_;
- my $boundary = time;
- $boundary = "LedgerSMB-$self->{version}-$boundary";
- my $domain = $self->{from};
- $domain =~ s/(.*?\@|>)//g;
- my $msgid = "$boundary\@$domain";
+ my $boundary = time;
+ $boundary = "LedgerSMB-$self->{version}-$boundary";
+ my $domain = $self->{from};
+ $domain =~ s/(.*?\@|>)//g;
+ my $msgid = "$boundary\@$domain";
- $self->{charset} = "ISO-8859-1" unless $self->{charset};
+ $self->{charset} = "ISO-8859-1" unless $self->{charset};
- if ($out) {
- open(OUT, $out) or return "$out : $!";
- } else {
- open(OUT, ">-") or return "STDOUT : $!";
- }
+ if ($out) {
+ open(OUT, $out) or return "$out : $!";
+ } else {
+ open(OUT, ">-") or return "STDOUT : $!";
+ }
- $self->{contenttype} = "text/plain" unless $self->{contenttype};
+ $self->{contenttype} = "text/plain" unless $self->{contenttype};
- my %h;
- for (qw(from to cc bcc)) {
- $self->{$_} =~ s/\&lt;/</g;
- $self->{$_} =~ s/\&gt;/>/g;
- $self->{$_} =~ s/(\/|\\|\$)//g;
- $h{$_} = $self->{$_};
- }
+ my %h;
+ for (qw(from to cc bcc)) {
+ $self->{$_} =~ s/\&lt;/</g;
+ $self->{$_} =~ s/\&gt;/>/g;
+ $self->{$_} =~ s/(\/|\\|\$)//g;
+ $h{$_} = $self->{$_};
+ }
- $h{cc} = "Cc: $h{cc}\n" if $self->{cc};
- $h{bcc} = "Bcc: $h{bcc}\n" if $self->{bcc};
- $h{notify} = "Disposition-Notification-To: $h{from}\n" if $self->{notify};
- $h{subject} = ($self->{subject} =~ /([\x00-\x1F]|[\x7B-\xFFFF])/) ? "Subject: =?$self->{charset}?B?".&encode_base64($self->{subject},"")."?=" : "Subject: $self->{subject}";
+ $h{cc} = "Cc: $h{cc}\n" if $self->{cc};
+ $h{bcc} = "Bcc: $h{bcc}\n" if $self->{bcc};
+ $h{notify} = "Disposition-Notification-To: $h{from}\n"
+ if $self->{notify};
+ $h{subject} =
+ ($self->{subject} =~ /([\x00-\x1F]|[\x7B-\xFFFF])/)
+ ? "Subject: =?$self->{charset}?B?".
+ &encode_base64($self->{subject},"")."?="
+ : "Subject: $self->{subject}";
- print OUT qq|From: $h{from}
-To: $h{to}
-$h{cc}$h{bcc}$h{subject}
-Message-ID: <$msgid>
-$h{notify}X-Mailer: LedgerSMB $self->{version}
-MIME-Version: 1.0
-|;
-
-
- if (@{ $self->{attachments} }) {
- print OUT qq|Content-Type: multipart/mixed; boundary="$boundary"
-
-|;
- if ($self->{message} ne "") {
- print OUT qq|--${boundary}
-Content-Type: $self->{contenttype}; charset="$self->{charset}"
-
-$self->{message}
-
-|;
- }
-
- foreach my $attachment (@{ $self->{attachments} }) {
-
- my $application = ($attachment =~ /(^\w+$)|\.(html|text|txt|sql)$/) ? "text" : "application";
+ print OUT "From: $h{from}\n".
+ "To: $h{to}\n".
+ "$h{cc}$h{bcc}$h{subject}\n".
+ "Message-ID: <$msgid>\n".
+ "$h{notify}X-Mailer: LedgerSMB $self->{version}\n".
+ "MIME-Version: 1.0\n\n";
+
+
+ if (@{ $self->{attachments} }) {
+ print OUT
+ qq|Content-Type: multipart/mixed; |.
+ qq|boundary="$boundary"\n\n|;
+ if ($self->{message} ne "") {
+ print OUT qq|--${boundary}\n|.
+ qq|Content-Type: $self->{contenttype};|.
+ qq| charset="$self->{charset}"\n\n|.
+ qq|$self->{message}|;
+
+ }
+
+ foreach my $attachment (@{ $self->{attachments} }) {
+
+ my $application =
+ ($attachment =~
+ /(^\w+$)|\.(html|text|txt|sql)$/)
+ ? "text"
+ : "application";
- unless (open IN, $attachment) {
- close(OUT);
- return "$attachment : $!";
- }
+ unless (open IN, $attachment) {
+ close(OUT);
+ return "$attachment : $!";
+ }
- my $filename = $attachment;
- # strip path
- $filename =~ s/(.*\/|$self->{fileid})//g;
+ my $filename = $attachment;
+ # strip path
+ $filename =~ s/(.*\/|$self->{fileid})//g;
- print OUT qq|--${boundary}
-Content-Type: $application/$self->{format}; name="$filename"; charset="$self->{charset}"
-Content-Transfer-Encoding: BASE64
-Content-Disposition: attachment; filename="$filename"\n\n|;
-
- my $msg = "";
- while (<IN>) {;
- $msg .= $_;
- }
- print OUT &encode_base64($msg);
-
- close(IN);
+ print OUT qq|--${boundary}\n|.
+ qq|Content-Type: $application/$self->{format}; |
+ . qq|name="$filename"; |.
+ qq|charset="$self->{charset}"\n|.
+ qq|Content-Transfer-Encoding: BASE64\n|.
+ qq|Content-Disposition: attachment; |.
+ qq|filename="$filename"\n\n|;
+
+ my $msg = "";
+ while (<IN>) {;
+ $msg .= $_;
+ }
+ print OUT &encode_base64($msg);
+
+ close(IN);
- }
- print OUT qq|--${boundary}--\n|;
+ }
+ print OUT qq|--${boundary}--\n|;
- } else {
- print OUT qq|Content-Type: $self->{contenttype}; charset="$self->{charset}"
+ } else {
+ print OUT qq|Content-Type: $self->{contenttype}; |.
+ qq|charset="$self->{charset}"\n\n|.
+ qq|$self->{message}|;
+ }
-$self->{message}
-|;
- }
-
- close(OUT);
+ close(OUT);
- return "";
+ return "";
}
@@ -163,22 +172,22 @@ sub encode_base64 ($;$) {
# Contributors:
#
- my $res = "";
- my $eol = $_[1];
- $eol = "\n" unless defined $eol;
- pos($_[0]) = 0; # ensure start at the beginning
-
- $res = join '', map( pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs));
-
- $res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs
- # fix padding at the end
- my $padding = (3 - length($_[0]) % 3) % 3;
- $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
- # break encoded string into lines of no more than 60 characters each
- if (length $eol) {
- $res =~ s/(.{1,60})/$1$eol/g;
- }
- return $res;
+ my $res = "";
+ my $eol = $_[1];
+ $eol = "\n" unless defined $eol;
+ pos($_[0]) = 0; # ensure start at the beginning
+
+ $res = join '', map( pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs));
+
+ $res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs
+ # fix padding at the end
+ my $padding = (3 - length($_[0]) % 3) % 3;
+ $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
+ # break encoded string into lines of no more than 60 characters each
+ if (length $eol) {
+ $res =~ s/(.{1,60})/$1$eol/g;
+ }
+ return $res;
}
diff --git a/LedgerSMB/Menu.pm b/LedgerSMB/Menu.pm
index f61db708..344bb7d7 100755
--- a/LedgerSMB/Menu.pm
+++ b/LedgerSMB/Menu.pm
@@ -23,7 +23,7 @@
#
#======================================================================
#
-# This file has NOT undergone whitespace cleanup.
+# This file has undergone whitespace cleanup.
#
#======================================================================
#
@@ -38,72 +38,80 @@ use LedgerSMB::Inifile;
sub menuitem {
- my ($self, $myconfig, $form, $item) = @_;
-
- my $module = ($self->{$item}{module}) ? $self->{$item}{module} : $form->{script};
- my $action = ($self->{$item}{action}) ? $self->{$item}{action} : "section_menu";
- my $target = ($self->{$item}{target}) ? $self->{$item}{target} : "";
-
- my $level = $form->escape($item);
- my $str = qq|<a style="display:block;" href="$module?path=$form->{path}&amp;action=$action&amp;level=$level&amp;login=$form->{login}&amp;timeout=$form->{timeout}&amp;sessionid=$form->{sessionid}&amp;js=$form->{js}|;
-
- my @vars = qw(module action target href);
+ my ($self, $myconfig, $form, $item) = @_;
+
+ my $module = ($self->{$item}{module})
+ ? $self->{$item}{module} : $form->{script};
+ my $action = ($self->{$item}{action})
+ ? $self->{$item}{action} : "section_menu";
+ my $target = ($self->{$item}{target})
+ ? $self->{$item}{target} : "";
+
+ my $level = $form->escape($item);
+ my $str = qq|<a style="display:block;"|.
+ qq|href="$module?path=$form->{path}&amp;action=$action&amp;|.
+ qq|level=$level&amp;login=$form->{login}&amp;|.
+ qq|timeout=$form->{timeout}&amp;sessionid=$form->{sessionid}|.
+ qq|&amp;js=$form->{js}|;
+
+ my @vars = qw(module action target href);
- if ($self->{$item}{href}) {
- $str = qq|<a href="$self->{$item}{href}|;
- @vars = qw(module target href);
- }
+ if ($self->{$item}{href}) {
+ $str = qq|<a href="$self->{$item}{href}|;
+ @vars = qw(module target href);
+ }
- for (@vars) { delete $self->{$item}{$_} }
+ for (@vars) { delete $self->{$item}{$_} }
- delete $self->{$item}{submenu};
+ delete $self->{$item}{submenu};
- # add other params
- foreach my $key (keys %{ $self->{$item} }) {
- $str .= "&amp;".$form->escape($key)."=";
- ($value, $conf) = split /=/, $self->{$item}{$key}, 2;
- $value = "$myconfig->{$value}$conf" if $self->{$item}{$key} =~ /=/;
+ # add other params
+ foreach my $key (keys %{ $self->{$item} }) {
+ $str .= "&amp;".$form->escape($key)."=";
+ ($value, $conf) = split /=/, $self->{$item}{$key}, 2;
+ $value = "$myconfig->{$value}$conf"
+ if $self->{$item}{$key} =~ /=/;
- $str .= $form->escape($value);
- }
+ $str .= $form->escape($value);
+ }
- $str .= qq|#id$form->{tag}| if $target eq 'acc_menu';
+ $str .= qq|#id$form->{tag}| if $target eq 'acc_menu';
- if ($target) {
- $str .= qq|" target="$target"|;
- }
- else{
- $str .= '"';
- }
+ if ($target) {
+ $str .= qq|" target="$target"|;
+ }
+ else{
+ $str .= '"';
+ }
- $str .= qq|>|;
+ $str .= qq|>|;
}
sub access_control {
- my ($self, $myconfig, $menulevel) = @_;
+ my ($self, $myconfig, $menulevel) = @_;
- my @menu = ();
+ my @menu = ();
- if ($menulevel eq "") {
- @menu = grep { !/--/ } @{ $self->{ORDER} };
- } else {
- @menu = grep { /^${menulevel}--/; } @{ $self->{ORDER} };
- }
+ if ($menulevel eq "") {
+ @menu = grep { !/--/ } @{ $self->{ORDER} };
+ } else {
+ @menu = grep { /^${menulevel}--/; } @{ $self->{ORDER} };
+ }
- my @a = split /;/, $myconfig->{acs};
- my $excl = ();
+ my @a = split /;/, $myconfig->{acs};
+ my $excl = ();
- # remove --AR, --AP from array
- grep { ($a, $b) = split /--/; s/--$a$//; } @a;
+ # remove --AR, --AP from array
+ grep { ($a, $b) = split /--/; s/--$a$//; } @a;
- for (@a) { $excl{$_} = 1 }
+ for (@a) { $excl{$_} = 1 }
- @a = ();
- for (@menu) { push @a, $_ unless $excl{$_} }
+ @a = ();
+ for (@menu) { push @a, $_ unless $excl{$_} }
- @a;
+ @a;
}
diff --git a/LedgerSMB/Num2text.pm b/LedgerSMB/Num2text.pm
index e8093ab5..4cb79fec 100755
--- a/LedgerSMB/Num2text.pm
+++ b/LedgerSMB/Num2text.pm
@@ -33,9 +33,9 @@
sub init {
- my $self = shift;
+ my $self = shift;
- %{ $self->{numbername} } =
+ %{ $self->{numbername} } =
(0 => 'Zero',
1 => 'One',
2 => 'Two',
@@ -75,90 +75,90 @@ sub init {
sub num2text {
- my ($self, $amount) = @_;
+ my ($self, $amount) = @_;
- return $self->{numbername}{0} unless $amount;
+ return $self->{numbername}{0} unless $amount;
- my @textnumber = ();
+ my @textnumber = ();
- # split amount into chunks of 3
- my @num = reverse split //, abs($amount);
- my @numblock = ();
- my @a;
- my $i;
+ # split amount into chunks of 3
+ my @num = reverse split //, abs($amount);
+ my @numblock = ();
+ my @a;
+ my $i;
- while (@num) {
- @a = ();
- for (1 .. 3) {
- push @a, shift @num;
- }
- push @numblock, join / /, reverse @a;
- }
+ while (@num) {
+ @a = ();
+ for (1 .. 3) {
+ push @a, shift @num;
+ }
+ push @numblock, join / /, reverse @a;
+ }
- while (@numblock) {
+ while (@numblock) {
- $i = $#numblock;
- @num = split //, $numblock[$i];
+ $i = $#numblock;
+ @num = split //, $numblock[$i];
- if ($numblock[$i] == 0) {
- pop @numblock;
- next;
- }
+ if ($numblock[$i] == 0) {
+ pop @numblock;
+ next;
+ }
- if ($numblock[$i] > 99) {
- # the one from hundreds
- push @textnumber, $self->{numbername}{$num[0]};
+ if ($numblock[$i] > 99) {
+ # the one from hundreds
+ push @textnumber, $self->{numbername}{$num[0]};
- # add hundred designation
- push @textnumber, $self->{numbername}{10**2};
+ # add hundred designation
+ push @textnumber, $self->{numbername}{10**2};
- # reduce numblock
- $numblock[$i] -= $num[0] * 100;
+ # reduce numblock
+ $numblock[$i] -= $num[0] * 100;
- }
+ }
- $numblock[$i] *= 1;
+ $numblock[$i] *= 1;
- if ($numblock[$i] > 9) {
- # tens
- push @textnumber, $self->format_ten($numblock[$i]);
- } elsif ($numblock[$i] > 0) {
- # ones
- push @textnumber, $self->{numbername}{$numblock[$i]};
- }
+ if ($numblock[$i] > 9) {
+ # tens
+ push @textnumber, $self->format_ten($numblock[$i]);
+ } elsif ($numblock[$i] > 0) {
+ # ones
+ push @textnumber, $self->{numbername}{$numblock[$i]};
+ }
- # add thousand, million
- if ($i) {
- $num = 10**($i * 3);
- push @textnumber, $self->{numbername}{$num};
- }
+ # add thousand, million
+ if ($i) {
+ $num = 10**($i * 3);
+ push @textnumber, $self->{numbername}{$num};
+ }
- pop @numblock;
+ pop @numblock;
- }
+ }
- join ' ', @textnumber;
+ join ' ', @textnumber;
}
sub format_ten {
- my ($self, $amount) = @_;
+ my ($self, $amount) = @_;
- my $textnumber = "";
- my @num = split //, $amount;
+ my $textnumber = "";
+ my @num = split //, $amount;
- if ($amount > 20) {
- $textnumber = $self->{numbername}{$num[0]*10};
- $amount = $num[1];
- } else {
- $textnumber = $self->{numbername}{$amount};
- $amount = 0;
- }
+ if ($amount > 20) {
+ $textnumber = $self->{numbername}{$num[0]*10};
+ $amount = $num[1];
+ } else {
+ $textnumber = $self->{numbername}{$amount};
+ $amount = 0;
+ }
- $textnumber .= " ".$self->{numbername}{$amount} if $amount;
+ $textnumber .= " ".$self->{numbername}{$amount} if $amount;
- $textnumber;
+ $textnumber;
}