diff options
Diffstat (limited to 'LedgerSMB')
| -rwxr-xr-x | LedgerSMB/Inifile.pm | 69 | ||||
| -rwxr-xr-x | LedgerSMB/Mailer.pm | 203 | ||||
| -rwxr-xr-x | LedgerSMB/Menu.pm | 102 | ||||
| -rwxr-xr-x | LedgerSMB/Num2text.pm | 120 |
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/\</</g; - $self->{$_} =~ s/\>/>/g; - $self->{$_} =~ s/(\/|\\|\$)//g; - $h{$_} = $self->{$_}; - } + my %h; + for (qw(from to cc bcc)) { + $self->{$_} =~ s/\</</g; + $self->{$_} =~ s/\>/>/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}&action=$action&level=$level&login=$form->{login}&timeout=$form->{timeout}&sessionid=$form->{sessionid}&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}&action=$action&|. + qq|level=$level&login=$form->{login}&|. + qq|timeout=$form->{timeout}&sessionid=$form->{sessionid}|. + qq|&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 .= "&".$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 .= "&".$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; } |