=head1 NAME LedgerSMB::Setting - LedgerSMB class for managing Business Locations =head1 SYOPSIS This module creates object instances based on LedgerSMB's in-database ORM. =head1 METHODS The following method is static: =item new ($LedgerSMB object); The following methods are passed through to stored procedures: =item get ($self->{key}) =item get_default_accounts() (via AUTOLOAD) returns a list of accounts. =item set ($self->{key}, $self->{value}) =item parse_incriment ($self->{key}) This function updates a default entry in the database, incrimenting the last set of digits not including tags or non-digits, and then parses the returned value, doing tag substitution. The final value is then returned by the function. The above list may grow over time, and may depend on other installed modules. =head1 Copyright (C) 2007, The LedgerSMB core team. This file is licensed under the Gnu General Public License version 2, or at your option any later version. A copy of the license should have been included with your software. =back =cut package LedgerSMB::Setting; use LedgerSMB; use LedgerSMB::DBObject; use strict; our $VERSION = '1.0.0'; our @ISA = qw(LedgerSMB::DBObject); sub AUTOLOAD { my $self = shift; my $AUTOLOAD = $LedgerSMB::Setting::AUTOLOAD; $AUTOLOAD =~ s/^.*:://; $self->exec_method(procname => "setting_$AUTOLOAD", args =>\@_); } sub get { my $self = shift; my $hashref = shift @{$self->exec_method(procname => 'setting_get')}; $self->merge($hashref, 'value'); } sub parse_increment { my $self = shift; my $myconfig = shift; # Long-run, we may want to run this via Parse::RecDescent, but this is # at least a start for here. Chris T. # Replaces Form::UpdateDefaults $_ = $self->incriment; # check for and replace # , , , , or variations of # , , , # , , only for parts # for customer and vendors my $dbvar = $_; my $var = $_; my $str; my $param; if (/<\?lsmb /) { while (/<\?lsmb /) { s/<\?lsmb .*? \?>//; last unless $&; $param = $&; $str = ""; if ($param =~ /<\?lsmb date \?>/i) { $str = ($self->split_date($myconfig->{dateformat}, $self->{transdate}))[0]; $var =~ s/$param/$str/; } if ($param =~ /<\?lsmb (name|business|description|item|partsgroup|phone|custom)/i) { my $fld = lc $&; $fld =~ s/<\?lsmb //; if ($fld =~ /name/) { if ($self->{type}) { $fld = $self->{vc}; } } my $p = $param; $p =~ s/(<|>|%)//g; my @p = split / /, $p; my @n = split / /, uc $self->{$fld}; if ($#p > 0) { for (my $i = 1; $i <= $#p; $i++) { $str .= substr($n[$i-1], 0, $p[$i]); } } else { ($str) = split /--/, $self->{$fld}; } $var =~ s/$param/$str/; $var =~ s/\W//g if $fld eq 'phone'; } if ($param =~ /<\?lsmb (yy|mm|dd)/i) { my $p = $param; $p =~ s/(<|>|%)//g; my $spc = $p; $spc =~ s/\w//g; $spc = substr($spc, 0, 1); my %d = ( yy => 1, mm => 2, dd => 3 ); my @p = (); my @a = $self->split_date($myconfig->{dateformat}, $self->{transdate}); for (sort keys %d) { push @p, $a[$d{$_}] if ($p =~ /$_/) } $str = join $spc, @p; $var =~ s/$param/$str/; } if ($param =~ /<\?lsmb curr/i) { $var =~ s/$param/$self->{currency}/; } } } $self->{value} = $var; $var; }