summaryrefslogtreecommitdiff
path: root/LedgerSMB/Setting.pm
blob: 5ce6ca66991ceba4dff264eaa91aca164daea766 (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_incriment ($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 LedgerSMB;
  29. use LedgerSMB::DBObject;
  30. use strict;
  31. our $VERSION = '1.0.0';
  32. our @ISA = qw(LedgerSMB::DBObject);
  33. sub AUTOLOAD {
  34. my $self = shift;
  35. my $AUTOLOAD = $LedgerSMB::Setting::AUTOLOAD;
  36. $AUTOLOAD =~ s/^.*:://;
  37. $self->exec_method( procname => "setting_$AUTOLOAD", args => \@_ );
  38. }
  39. sub get {
  40. my $self = shift;
  41. my $hashref = shift @{ $self->exec_method( procname => 'setting_get' ) };
  42. $self->merge( $hashref, 'value' );
  43. }
  44. sub parse_increment {
  45. my $self = shift;
  46. my $myconfig = shift;
  47. # Long-run, we may want to run this via Parse::RecDescent, but this is
  48. # at least a start for here. Chris T.
  49. # Replaces Form::UpdateDefaults
  50. $_ = $self->incriment;
  51. # check for and replace
  52. # <?lsmb DATE ?>, <?lsmb YYMMDD ?>, <?lsmb YEAR ?>, <?lsmb MONTH ?>, <?lsmb DAY ?> or variations of
  53. # <?lsmb NAME 1 1 3 ?>, <?lsmb BUSINESS ?>, <?lsmb BUSINESS 10 ?>, <?lsmb CURR... ?>
  54. # <?lsmb DESCRIPTION 1 1 3 ?>, <?lsmb ITEM 1 1 3 ?>, <?lsmb PARTSGROUP 1 1 3 ?> only for parts
  55. # <?lsmb PHONE ?> for customer and vendors
  56. my $dbvar = $_;
  57. my $var = $_;
  58. my $str;
  59. my $param;
  60. if (/<\?lsmb /) {
  61. while (/<\?lsmb /) {
  62. s/<\?lsmb .*? \?>//;
  63. last unless $&;
  64. $param = $&;
  65. $str = "";
  66. if ( $param =~ /<\?lsmb date \?>/i ) {
  67. $str = (
  68. $self->split_date(
  69. $myconfig->{dateformat},
  70. $self->{transdate}
  71. )
  72. )[0];
  73. $var =~ s/$param/$str/;
  74. }
  75. if ( $param =~
  76. /<\?lsmb (name|business|description|item|partsgroup|phone|custom)/i
  77. )
  78. {
  79. my $fld = lc $&;
  80. $fld =~ s/<\?lsmb //;
  81. if ( $fld =~ /name/ ) {
  82. if ( $self->{type} ) {
  83. $fld = $self->{vc};
  84. }
  85. }
  86. my $p = $param;
  87. $p =~ s/(<|>|%)//g;
  88. my @p = split / /, $p;
  89. my @n = split / /, uc $self->{$fld};
  90. if ( $#p > 0 ) {
  91. for ( my $i = 1 ; $i <= $#p ; $i++ ) {
  92. $str .= substr( $n[ $i - 1 ], 0, $p[$i] );
  93. }
  94. }
  95. else {
  96. ($str) = split /--/, $self->{$fld};
  97. }
  98. $var =~ s/$param/$str/;
  99. $var =~ s/\W//g if $fld eq 'phone';
  100. }
  101. if ( $param =~ /<\?lsmb (yy|mm|dd)/i ) {
  102. my $p = $param;
  103. $p =~ s/(<|>|%)//g;
  104. my $spc = $p;
  105. $spc =~ s/\w//g;
  106. $spc = substr( $spc, 0, 1 );
  107. my %d = ( yy => 1, mm => 2, dd => 3 );
  108. my @p = ();
  109. my @a = $self->split_date( $myconfig->{dateformat},
  110. $self->{transdate} );
  111. for ( sort keys %d ) { push @p, $a[ $d{$_} ] if ( $p =~ /$_/ ) }
  112. $str = join $spc, @p;
  113. $var =~ s/$param/$str/;
  114. }
  115. if ( $param =~ /<\?lsmb curr/i ) {
  116. $var =~ s/$param/$self->{currency}/;
  117. }
  118. }
  119. }
  120. $self->{value} = $var;
  121. $var;
  122. }