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