summaryrefslogtreecommitdiff
path: root/LedgerSMB/Setting.pm
blob: 282bfd8efaa6abc38b6077721422a33c1734897d (plain)
  1. =head1 NAME
  2. LedgerSMB::Setting - LedgerSMB class for managing Business Locations
  3. =head1 SYOPSIS
  4. This module creates object instances based on LedgerSMB's in-database ORM.
  5. =head1 METHODS
  6. The following method is static:
  7. =item new ($LedgerSMB object);
  8. The following methods are passed through to stored procedures:
  9. =item get ($self->{key})
  10. =item get_default_accounts() (via AUTOLOAD) returns a list of accounts.
  11. =item set ($self->{key}, $self->{value})
  12. =item parse_incriment ($self->{key})
  13. This function updates a default entry in the database, incrimenting the last
  14. set of digits not including <?lsmb ?> tags or non-digits, and then parses the
  15. returned value, doing tag substitution. The final value is then returned by
  16. the function.
  17. The above list may grow over time, and may depend on other installed modules.
  18. =head1 Copyright (C) 2007, The LedgerSMB core team.
  19. This file is licensed under the Gnu General Public License version 2, or at your
  20. option any later version. A copy of the license should have been included with
  21. your software.
  22. =back
  23. =cut
  24. package LedgerSMB::Setting;
  25. use LedgerSMB;
  26. use LedgerSMB::DBObject;
  27. use strict;
  28. our $VERSION = '1.0.0';
  29. our @ISA = qw(LedgerSMB::DBObject);
  30. sub AUTOLOAD {
  31. my $self = shift;
  32. my $AUTOLOAD = $LedgerSMB::Setting::AUTOLOAD;
  33. $AUTOLOAD =~ s/^.*:://;
  34. $self->exec_method( procname => "setting_$AUTOLOAD", args => \@_ );
  35. }
  36. sub get {
  37. my $self = shift;
  38. my $hashref = shift @{ $self->exec_method( procname => 'setting_get' ) };
  39. $self->merge( $hashref, 'value' );
  40. }
  41. sub parse_increment {
  42. my $self = shift;
  43. my $myconfig = shift;
  44. # Long-run, we may want to run this via Parse::RecDescent, but this is
  45. # at least a start for here. Chris T.
  46. # Replaces Form::UpdateDefaults
  47. $_ = $self->incriment;
  48. # check for and replace
  49. # <?lsmb DATE ?>, <?lsmb YYMMDD ?>, <?lsmb YEAR ?>, <?lsmb MONTH ?>, <?lsmb DAY ?> or variations of
  50. # <?lsmb NAME 1 1 3 ?>, <?lsmb BUSINESS ?>, <?lsmb BUSINESS 10 ?>, <?lsmb CURR... ?>
  51. # <?lsmb DESCRIPTION 1 1 3 ?>, <?lsmb ITEM 1 1 3 ?>, <?lsmb PARTSGROUP 1 1 3 ?> only for parts
  52. # <?lsmb PHONE ?> for customer and vendors
  53. my $dbvar = $_;
  54. my $var = $_;
  55. my $str;
  56. my $param;
  57. if (/<\?lsmb /) {
  58. while (/<\?lsmb /) {
  59. s/<\?lsmb .*? \?>//;
  60. last unless $&;
  61. $param = $&;
  62. $str = "";
  63. if ( $param =~ /<\?lsmb date \?>/i ) {
  64. $str = (
  65. $self->split_date(
  66. $myconfig->{dateformat},
  67. $self->{transdate}
  68. )
  69. )[0];
  70. $var =~ s/$param/$str/;
  71. }
  72. if ( $param =~
  73. /<\?lsmb (name|business|description|item|partsgroup|phone|custom)/i
  74. )
  75. {
  76. my $fld = lc $&;
  77. $fld =~ s/<\?lsmb //;
  78. if ( $fld =~ /name/ ) {
  79. if ( $self->{type} ) {
  80. $fld = $self->{vc};
  81. }
  82. }
  83. my $p = $param;
  84. $p =~ s/(<|>|%)//g;
  85. my @p = split / /, $p;
  86. my @n = split / /, uc $self->{$fld};
  87. if ( $#p > 0 ) {
  88. for ( my $i = 1 ; $i <= $#p ; $i++ ) {
  89. $str .= substr( $n[ $i - 1 ], 0, $p[$i] );
  90. }
  91. }
  92. else {
  93. ($str) = split /--/, $self->{$fld};
  94. }
  95. $var =~ s/$param/$str/;
  96. $var =~ s/\W//g if $fld eq 'phone';
  97. }
  98. if ( $param =~ /<\?lsmb (yy|mm|dd)/i ) {
  99. my $p = $param;
  100. $p =~ s/(<|>|%)//g;
  101. my $spc = $p;
  102. $spc =~ s/\w//g;
  103. $spc = substr( $spc, 0, 1 );
  104. my %d = ( yy => 1, mm => 2, dd => 3 );
  105. my @p = ();
  106. my @a = $self->split_date( $myconfig->{dateformat},
  107. $self->{transdate} );
  108. for ( sort keys %d ) { push @p, $a[ $d{$_} ] if ( $p =~ /$_/ ) }
  109. $str = join $spc, @p;
  110. $var =~ s/$param/$str/;
  111. }
  112. if ( $param =~ /<\?lsmb curr/i ) {
  113. $var =~ s/$param/$self->{currency}/;
  114. }
  115. }
  116. }
  117. $self->{value} = $var;
  118. $var;
  119. }