Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100755 1112 lines (901 sloc) 33.003 kB
0a4abf2 POD fixes and POD syntax tests
tetragon authored
1
6241ff6 renamed LedgerSMB::callproc to call_procedure. Reworked a number of …
einhverfr authored
2 =head1 NAME
3
68e3173 Correct NAME section POD in various *.pm files.
jame authored
4 LedgerSMB - The Base class for many LedgerSMB objects, including DBObject.
6241ff6 renamed LedgerSMB::callproc to call_procedure. Reworked a number of …
einhverfr authored
5
54f9a9f Adding pod to Locale.pm
tetragon authored
6 =head1 SYNOPSIS
6241ff6 renamed LedgerSMB::callproc to call_procedure. Reworked a number of …
einhverfr authored
7
fa02f0b Updated LedgerSMB.pm
einhverfr authored
8 This module creates a basic request handler with utility functions available
9 in database objects (LedgerSMB::DBObject)
6241ff6 renamed LedgerSMB::callproc to call_procedure. Reworked a number of …
einhverfr authored
10
11 =head1 METHODS
12
0a4abf2 POD fixes and POD syntax tests
tetragon authored
13 =over
14
6241ff6 renamed LedgerSMB::callproc to call_procedure. Reworked a number of …
einhverfr authored
15 =item new ()
0a4abf2 POD fixes and POD syntax tests
tetragon authored
16
a51eb1d Correcting POD on LedgerSMB.pm, changing db_init to _db_init and call…
einhverfr authored
17 This method creates a new base request instance. It also validates the
18 session/user credentials, as appropriate for the run mode. Finally, it sets up
19 the database connections for the user.
6241ff6 renamed LedgerSMB::callproc to call_procedure. Reworked a number of …
einhverfr authored
20
b058034 Adding ledgersmb.conf.default
einhverfr authored
21 =item date_to_number (user => $LedgerSMB::User, date => $string);
0a4abf2 POD fixes and POD syntax tests
tetragon authored
22
b058034 Adding ledgersmb.conf.default
einhverfr authored
23 This function takes the date in the format provided and returns a numeric
24 string in YYMMDD format. This may be moved to User in the future.
25
8803f07 XSRF prevention in customer/vendor handling added
einhverfr authored
26 =item open_form()
27
28 This sets a $self->{form_id} to be used in later form validation (anti-XSRF
29 measure).
30
31 =item check_form()
32
33 This returns true if the form_id was associated with the session, and false if
34 not. Use this if the form may be re-used (back-button actions are valid).
35
36 =item close_form()
37
38 Identical with check_form() above, but also removes the form_id from the
39 session. This should be used when back-button actions are not valid.
40
6241ff6 renamed LedgerSMB::callproc to call_procedure. Reworked a number of …
einhverfr authored
41 =item debug (file => $path);
42
43 This dumps the current object to the file if that is defined and otherwise to
44 standard output.
45
46 =item escape (string => $string);
47
48 This function returns the current string escaped using %hexhex notation.
49
50 =item unescape (string => $string);
51
52 This function returns the $string encoded using %hexhex using ordinary notation.
53
fa02f0b Updated LedgerSMB.pm
einhverfr authored
54 =item format_amount (user => $LedgerSMB::User::hash, amount => $string, precision => $integer, neg_format => (-|DRCR));
55
56 The function takes a monetary amount and formats it according to the user
b058034 Adding ledgersmb.conf.default
einhverfr authored
57 preferences, the negative format (- or DR/CR). Note that it may move to
58 LedgerSMB::User at some point in the future.
59
60 =item parse_amount (user => $LedgerSMB::User::hash, amount => $variable);
0a4abf2 POD fixes and POD syntax tests
tetragon authored
61
b058034 Adding ledgersmb.conf.default
einhverfr authored
62 If $amount is a Bigfloat, it is returned as is. If it is a string, it is
63 parsed according to the user preferences stored in the LedgerSMB::User object.
fa02f0b Updated LedgerSMB.pm
einhverfr authored
64
adf7a85 LedgerSMB::redo_rows is broken for now but unused. All functions in …
einhverfr authored
65 =item is_blank (name => $string)
0a4abf2 POD fixes and POD syntax tests
tetragon authored
66
adf7a85 LedgerSMB::redo_rows is broken for now but unused. All functions in …
einhverfr authored
67 This function returns true if $self->{$string} only consists of whitespace
68 characters or is an empty string.
6241ff6 renamed LedgerSMB::callproc to call_procedure. Reworked a number of …
einhverfr authored
69
119f418 Added LedgerSMB::is_run_mode
einhverfr authored
70 =item is_run_mode ('(cli|cgi|mod_perl)')
0a4abf2 POD fixes and POD syntax tests
tetragon authored
71
119f418 Added LedgerSMB::is_run_mode
einhverfr authored
72 This function returns 1 if the run mode is what is specified. Otherwise
73 returns 0.
74
0befab1 Role lookups now working in the application code
einhverfr authored
75 =item is_allowed_role({allowed_roles => @role_names})
0a4abf2 POD fixes and POD syntax tests
tetragon authored
76
dcfdaee Adding role checking function for UI use
einhverfr authored
77 This function returns 1 if the user's roles include any of the roles in
ce16906 Closing bug 3372882
einhverfr authored
78 @role_names.
dcfdaee Adding role checking function for UI use
einhverfr authored
79
6241ff6 renamed LedgerSMB::callproc to call_procedure. Reworked a number of …
einhverfr authored
80 =item num_text_rows (string => $string, cols => $number, max => $number);
81
82 This function determines the likely number of rows needed to hold text in a
83 textbox. It returns either that number or max, which ever is lower.
84
7555d49 Mostly done rewriting LedgerSMB.pm. There are a few areas that still…
einhverfr authored
85 =item merge ($hashref, keys => @list, index => $number);
0a4abf2 POD fixes and POD syntax tests
tetragon authored
86
7555d49 Mostly done rewriting LedgerSMB.pm. There are a few areas that still…
einhverfr authored
87 This command merges the $hashref into the current object. If keys are
88 specified, only those keys are used. Otherwise all keys are merged.
89
90 If an index is specified, the merged keys are given a form of
91 "$key" . "_$index", otherwise the key is used on both sides.
92
6241ff6 renamed LedgerSMB::callproc to call_procedure. Reworked a number of …
einhverfr authored
93 =item redirect (msg => $string)
94
95 This function redirects to the script and argument set determined by
96 $self->{callback}, and if this is not set, goes to an info screen and prints
97 $msg.
98
547e6b5 Adding completed LedgerSMB::redo_rows
einhverfr authored
99 =item redo_rows (fields => \@list, count => $integer, [index => $string);
0a4abf2 POD fixes and POD syntax tests
tetragon authored
100
547e6b5 Adding completed LedgerSMB::redo_rows
einhverfr authored
101 This function is undergoing serious redesign at the moment. If index is
102 defined, that field is used for ordering the rows. If not, runningnumber is
ade3672 Moved LedgerSMB::new to use CGI.pm for parameter parsing.
einhverfr authored
103 used. Behavior is not defined when index points to a field containing
104 non-numbers.
7555d49 Mostly done rewriting LedgerSMB.pm. There are a few areas that still…
einhverfr authored
105
1151179 Moving Aurynn's set() function from DBObject to LedgerSMB namespaces …
einhverfr authored
106 =item set (@attrs)
107
108 Copies the given key=>vars to $self. Allows for finer control of
109 merging hashes into self.
110
03bfa82 Added a routine to sanitize the CGI variables. Needed for some CSV e…
einhverfr authored
111 =item remove_cgi_globals()
112
113 Removes all elements starting with a . because these elements conflict with the
114 ability to hide the entire structure for things like CSV lookups.
115
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
116 =item get_default_value_by_key($key)
945d972 David Mora's overpayment fixes
einhverfr authored
117
118 Retrieves a default value for the given key, it is just a wrapper on LedgerSMB::Setting;
119
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
120
121 =item call_procedure( procname => $procname, args => $args )
122
5e103cc API Change on LedgerSMB->call_procedure to accommodate bytea's, and a…
einhverfr authored
123 Function that allows you to call a stored procedure by name and map the appropriate argument to the function values.
124
125 Args is an arrayref. The members of args can be scalars or arrayrefs in which
126 case they are just bound to the placeholders (arrayref to Pg array conversion
127 occurs automatically in DBD::Pg 2.x), or they can be hashrefs of the following
128 syntax: {value => $data, type=> $db_type}. The type field is any SQL type
129 DBD::Pg supports (such as 'PG_BYTEA').
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
130
131 =item dberror()
132
133 Localizes and returns database errors and error codes within LedgerSMB
134
135 =item error()
136
137 Returns HTML errors in LedgerSMB. Needs refactored into a general Error class.
138
139 =item get_user_info()
140
141 Loads user configuration info from LedgerSMB::User
142
143 =item round_amount()
144
145 Uses Math::Float with an amount and a set number of decimal places to round the amount and return it.
146
147 Defaults to the default decimal places setting in the LedgerSMB configuration if there is no places argument passed in.
148
149 They should be changed to allow different rules for different accounts.
150
151 =item sanitize_for_display()
152
153 Expands a hash into human-readable key => value pairs, and formats and rounds amounts, recursively expanding hashes until there are no hash members present.
154
155 =item take_top_level()
156
157 Removes blank keys and non-reference keys from a hash and returns a hash with only non-blank and referenced keys.
158
159 =item type()
160
161 Ensures that the $ENV{REQUEST_METHOD} is defined and either "HEAD", "GET", "POST".
162
5b1ee72 Correcting POD so it parses properly
einhverfr authored
163 =item finalize_request()
164
165 This function throws a CancelFurtherProcessing exception to be caught
166 by the outermost processing script. This construct allows the outer
167 script and intermediate levels to clean up, if required.
168
169 This construct replaces 'exit;' calls randomly scattered
170 around the code everywhere.
171
172 =cut
173
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
174
0a4abf2 POD fixes and POD syntax tests
tetragon authored
175 =back
176
945d972 David Mora's overpayment fixes
einhverfr authored
177
178
6241ff6 renamed LedgerSMB::callproc to call_procedure. Reworked a number of …
einhverfr authored
179 =head1 Copyright (C) 2006, The LedgerSMB core team.
180
0a4abf2 POD fixes and POD syntax tests
tetragon authored
181 # This work contains copyrighted information from a number of sources
182 # all used with permission.
183 #
184 # This file contains source code included with or based on SQL-Ledger
185 # which is Copyright Dieter Simader and DWS Systems Inc. 2000-2005
186 # and licensed under the GNU General Public License version 2 or, at
187 # your option, any later version. For a full list including contact
188 # information of contributors, maintainers, and copyright holders,
189 # see the CONTRIBUTORS file.
190 #
191 # Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork):
192 # Copyright (C) 2000
193 #
194 # Author: DWS Systems Inc.
195 # Web: http://www.sql-ledger.org
196 #
197 # Contributors: Thomas Bayen <bayen@gmx.de>
198 # Antti Kaihola <akaihola@siba.fi>
199 # Moritz Bunkus (tex)
200 # Jim Rawlings <jim@your-dba.com> (DB2)
201 #====================================================================
6241ff6 renamed LedgerSMB::callproc to call_procedure. Reworked a number of …
einhverfr authored
202 =cut
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
203
564ad98 CGI.pm -> CGI::Simple switch
tetragon authored
204 use CGI::Simple;
a72324f Enabling file uploads in CGI::Simple
einhverfr authored
205 $CGI::Simple::DISABLE_UPLOADS = 0;
d8e2fd9 PGNumber now passes all number tests.
einhverfr authored
206 use LedgerSMB::PGNumber;
cc2d9bc Framework fixes. Can now log in and edit users in trunk
einhverfr authored
207 use LedgerSMB::PGDate;
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
208 use LedgerSMB::Sysconfig;
6241ff6 renamed LedgerSMB::callproc to call_procedure. Reworked a number of …
einhverfr authored
209 use Data::Dumper;
bffd2ff Replace scattered 'exit;' calls by exception handling,
ehuelsmann authored
210 use Error;
00c6d34 Adding centralized db commits when sending HTTP output
einhverfr authored
211 use LedgerSMB::App_State;
27c5a57 Renaming the Session namespace to LedgerSMB::Auth
einhverfr authored
212 use LedgerSMB::Auth;
9e610cd More Framework Enhancements
einhverfr authored
213 use LedgerSMB::Session;
bffd2ff Replace scattered 'exit;' calls by exception handling,
ehuelsmann authored
214 use LedgerSMB::CancelFurtherProcessing;
426e5a7 session expired/password request screen now uses UI templates
einhverfr authored
215 use LedgerSMB::Template;
71ec995 Altering test cases to better match LedgerSMB.pm
einhverfr authored
216 use LedgerSMB::Locale;
217 use LedgerSMB::User;
945d972 David Mora's overpayment fixes
einhverfr authored
218 use LedgerSMB::Setting;
148cbdd Default email addresses etc tied into templates
einhverfr authored
219 use LedgerSMB::Company_Config;
665470f LedgerSMB.pm now uses strict
einhverfr authored
220 use strict;
40dfe99 Correcting UTF8 issues in new codebase
einhverfr authored
221 use utf8;
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
222
f09e568 Disabling upload limits
einhverfr authored
223 $CGI::Simple::POST_MAX = -1;
224
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
225 package LedgerSMB;
c24152b Versioning changes for trunk, merging changelog from branches/1.3
einhverfr authored
226 our $VERSION = '1.3.999';
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
227
1bf55c0 One can now set taxes for customers/vendors
einhverfr authored
228 my $logger = Log::Log4perl->get_logger('LedgerSMB');
229
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
230 sub new {
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
231 #my $type = "" unless defined shift @_;
232 #my $argstr = "" unless defined shift @_;
29831de let LedgerSMB reuse already acquired dbh-handle,avoid msg:Issuing rol…
tshvr authored
233 (my $package,my $filename,my $line)=caller;
234
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
235 my $type = shift @_;
236 my $argstr = shift @_;
31d92e4 More authentication fixes.
einhverfr authored
237 my %cookie;
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
238 my $self = {};
31d92e4 More authentication fixes.
einhverfr authored
239
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
240 $type = "" unless defined $type;
241 $argstr = "" unless defined $argstr;
242
29831de let LedgerSMB reuse already acquired dbh-handle,avoid msg:Issuing rol…
tshvr authored
243 $logger->debug("Begin called from \$filename=$filename \$line=$line \$type=$type \$argstr=$argstr ref argstr=".ref $argstr);
31d92e4 More authentication fixes.
einhverfr authored
244
449cb9a Moving versioning string into the standard place for LedgerSMB.pm. I…
einhverfr authored
245 $self->{version} = $VERSION;
a1d05aa all non-db tests passing
einhverfr authored
246 $self->{dbversion} = "1.3.999";
0983be1 Correcting test case failure
einhverfr authored
247
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
248 bless $self, $type;
29831de let LedgerSMB reuse already acquired dbh-handle,avoid msg:Issuing rol…
tshvr authored
249
250 my $query;
251 my %params=();
252 if(ref($argstr) eq 'DBI::db')
253 {
254 $self->{dbh}=$argstr;
255 $logger->info("setting dbh from argstr \$self->{dbh}=$self->{dbh}");
256 }
257 else
258 {
259 $query = ($argstr) ? new CGI::Simple($argstr) : new CGI::Simple;
260 # my $params = $query->Vars; returns a tied hash with keys that
261 # are not parameters of the CGI query.
262 %params = $query->Vars;
263 for my $p(keys %params){
264 utf8::decode($params{$p});
265 utf8::upgrade($params{$p});
266 }
1d020d5 better handling of successive logouts,set default locale earlier so o…
tshvr authored
267 $logger->debug("params=", Data::Dumper::Dumper(\%params));
29831de let LedgerSMB reuse already acquired dbh-handle,avoid msg:Issuing rol…
tshvr authored
268 }
999850b Fixing frameset title
einhverfr authored
269 $self->{VERSION} = $VERSION;
19cf13c Reconciliation bank file fixes
einhverfr authored
270 $self->{_request} = $query;
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
271
1bf55c0 One can now set taxes for customers/vendors
einhverfr authored
272 $self->merge(\%params);
18c50f3 Adding vendor number to payments report.
einhverfr authored
273 $self->{have_latex} = $LedgerSMB::Sysconfig::latex;
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
274
d4f3ec5 AR/AP Breakage Fixed
einhverfr authored
275 # Adding this so that empty values are stored in the db as NULL's. If
276 # stored procedures want to handle them differently, they must opt to do so.
277 # -- CT
278 for (keys %$self){
279 if ($self->{$_} eq ''){
280 $self->{$_} = undef;
281 }
282 }
283
31d92e4 More authentication fixes.
einhverfr authored
284 if ($self->is_run_mode('cgi', 'mod_perl')) {
285 $ENV{HTTP_COOKIE} =~ s/;\s*/;/g;
286 my @cookies = split /;/, $ENV{HTTP_COOKIE};
287 foreach (@cookies) {
288 my ( $name, $value ) = split /=/, $_, 2;
289 $cookie{$name} = $value;
290 }
291 }
1d020d5 better handling of successive logouts,set default locale earlier so o…
tshvr authored
292 #HV set _locale already to default here,so routines lower in stack can use it;e.g. login.pl
293 $self->{_locale}=LedgerSMB::Locale->get_handle(${LedgerSMB::Sysconfig::language})
294 or $self->error( __FILE__ . ':' . __LINE__ .": Locale not loaded: $!\n" );
295
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
296 $self->{action} = "" unless defined $self->{action};
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
297 $self->{action} =~ s/\W/_/g;
298 $self->{action} = lc $self->{action};
0af29a7 Removing executable bit from documentation
einhverfr authored
299
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
300 $self->{path} = "" unless defined $self->{path};
301
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
302 if ( $self->{path} eq "bin/lynx" ) {
303 $self->{menubar} = 1;
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
304
2c60683 Login is still broken. However, a lot of progress has been made. TH…
einhverfr authored
305 # Applying the path is deprecated. Use menubar instead. CT.
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
306 $self->{lynx} = 1;
307 $self->{path} = "bin/lynx";
308 }
309 else {
310 $self->{path} = "bin/mozilla";
0af29a7 Removing executable bit from documentation
einhverfr authored
311
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
312 }
5ac924a Renamed images to ledgersmb*
einhverfr authored
313
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
314 $ENV{SCRIPT_NAME} = "" unless defined $ENV{SCRIPT_NAME};
315
c6ead05 Fix for menus with Javascript turned off
einhverfr authored
316 $ENV{SCRIPT_NAME} =~ m/([^\/\\]*.pl)\?*.*$/;
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
317 $self->{script} = $1 unless !defined $1;
318 $self->{script} = "" unless defined $self->{script};
c6ead05 Fix for menus with Javascript turned off
einhverfr authored
319
564ad98 CGI.pm -> CGI::Simple switch
tetragon authored
320 if ( ( $self->{script} =~ m#(\.\.|\\|/)# ) ) {
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
321 $self->error("Access Denied");
322 }
2c60683 Login is still broken. However, a lot of progress has been made. TH…
einhverfr authored
323 if (!$self->{script}) {
324 $self->{script} = 'login.pl';
325 }
1d020d5 better handling of successive logouts,set default locale earlier so o…
tshvr authored
326 $logger->debug("\$self->{script} = $self->{script} \$self->{action} = $self->{action}");
819ab93 Correcting problem in DBObject.pm constructor
einhverfr authored
327 # if ($self->{action} eq 'migrate_user'){
328 # return $self;
329 # }
0983be1 Correcting test case failure
einhverfr authored
330
331 # This is suboptimal. We need to have a better way for 1.4
1d020d5 better handling of successive logouts,set default locale earlier so o…
tshvr authored
332 #HV we should try to have DBI->connect in one place?
333 #HV why not trying _db_init also in case of login authenticate? quid logout-function?
428f6a8 Correcting trial balance and gl report not to pull unapproved transac…
einhverfr authored
334 if ($self->{script} eq 'login.pl' &&
819ab93 Correcting problem in DBObject.pm constructor
einhverfr authored
335 ($self->{action} eq 'authenticate' || $self->{action} eq '__default'
336 || !$self->{action})){
ad8fbf5 If no login sent, return simple credential-free object
einhverfr authored
337 return $self;
338 }
0983be1 Correcting test case failure
einhverfr authored
339 if ($self->{script} eq 'setup.pl'){
340 return $self;
341 }
1d020d5 better handling of successive logouts,set default locale earlier so o…
tshvr authored
342 my $ccookie;
31d92e4 More authentication fixes.
einhverfr authored
343 if (!$self->{company} && $self->is_run_mode('cgi', 'mod_perl')){
1d020d5 better handling of successive logouts,set default locale earlier so o…
tshvr authored
344 $ccookie = $cookie{${LedgerSMB::Sysconfig::cookie_name}};
31d92e4 More authentication fixes.
einhverfr authored
345 $ccookie =~ s/.*:([^:]*)$/$1/;
c97c71a fix for bug 3418336 per Herman Vierendeels
einhverfr authored
346 if($ccookie ne 'Login') { $self->{company} = $ccookie; }
31d92e4 More authentication fixes.
einhverfr authored
347 }
1d020d5 better handling of successive logouts,set default locale earlier so o…
tshvr authored
348 $logger->debug("\$ccookie=$ccookie cookie.LedgerSMB::Sysconfig::cookie_name=".$cookie{${LedgerSMB::Sysconfig::cookie_name}}." \$self->{company}=$self->{company}");
79cb0d1 Setting things up so that the LedgerSMB.pm tests run
einhverfr authored
349
1d020d5 better handling of successive logouts,set default locale earlier so o…
tshvr authored
350 if(! $cookie{${LedgerSMB::Sysconfig::cookie_name}} && $self->{action} eq 'logout')
351 {
352 $logger->debug("quitting because of logout and no cookie,avoid _db_init");
353 return $self;
354 }
2c60683 Login is still broken. However, a lot of progress has been made. TH…
einhverfr authored
355
1d020d5 better handling of successive logouts,set default locale earlier so o…
tshvr authored
356 #dbh may have been set elsewhere,by DBObject.pm?
357 if(!$self->{dbh})
358 {
359 $self->_db_init;
360 }
361 LedgerSMB::Company_Config::initialize($self);
1335838 User password setting and saving preferences now works (on new codebase)
einhverfr authored
362
1d020d5 better handling of successive logouts,set default locale earlier so o…
tshvr authored
363 #TODO move before _db_init to avoid _db_init with invalid session?
d28386f Correcting freelock's bug regarding saving orders
einhverfr authored
364 if ($self->is_run_mode('cgi', 'mod_perl') and !$ENV{LSMB_NOHEAD}) {
e554905 Moving menus to unorderded lists. CSS still need a few changes, but …
einhverfr authored
365 #check for valid session unless this is an inital authentication
2c60683 Login is still broken. However, a lot of progress has been made. TH…
einhverfr authored
366 #request -- CT
9e610cd More Framework Enhancements
einhverfr authored
367 if (!LedgerSMB::Session::check( $cookie{${LedgerSMB::Sysconfig::cookie_name}}, $self) ) {
1bf55c0 One can now set taxes for customers/vendors
einhverfr authored
368 $logger->error("Session did not check");
2c60683 Login is still broken. However, a lot of progress has been made. TH…
einhverfr authored
369 $self->_get_password("Session Expired");
370 exit;
371 }
1d020d5 better handling of successive logouts,set default locale earlier so o…
tshvr authored
372 $logger->debug("session_check completed OK \$self->{session_id}=$self->{session_id} caller=\$filename=$filename \$line=$line");
2c60683 Login is still broken. However, a lot of progress has been made. TH…
einhverfr authored
373 }
1335838 User password setting and saving preferences now works (on new codebase)
einhverfr authored
374 $self->get_user_info;
60ef7ef Adding proper dateformat handling to LedgerSMB.pm
einhverfr authored
375
1397a4b Correcting load errors in LedgerSMB.pm, LedgerSMB/Form.pm, and Ledger…
einhverfr authored
376 my %date_setting = (
377 'mm/dd/yy' => "SQL, US",
378 'mm-dd-yy' => "POSTGRES, US",
379 'dd/mm/yy' => "SQL, EUROPEAN",
380 'dd-mm-yy' => "POSTGRES, EUROPEAN",
381 'dd.mm.yy' => "GERMAN",
382 );
383
1d020d5 better handling of successive logouts,set default locale earlier so o…
tshvr authored
384 $self->{dbh}->do("set DateStyle to '".$date_setting{$self->{_user}->{dateformat}}."'");
385 #my $locale = LedgerSMB::Locale->get_handle($self->{_user}->{language})
386 # or $self->error(__FILE__.':'.__LINE__.": Locale not loaded: $!\n");
387 #$self->{_locale} = $locale;
388 $self->{_locale}=LedgerSMB::Locale->get_handle($self->{_user}->{language})
31d92e4 More authentication fixes.
einhverfr authored
389 or $self->error(__FILE__.':'.__LINE__.": Locale not loaded: $!\n");
2c60683 Login is still broken. However, a lot of progress has been made. TH…
einhverfr authored
390
8066acc Merging in David Mora's payment changes. Still working on the templa…
einhverfr authored
391 $self->{stylesheet} = $self->{_user}->{stylesheet};
70214db Fixing new framework for session and user authentication
einhverfr authored
392
bbb4b26 only logging changes
tshvr authored
393 $logger->debug("End");
1bf55c0 One can now set taxes for customers/vendors
einhverfr authored
394
31d92e4 More authentication fixes.
einhverfr authored
395 return $self;
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
396
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
397 }
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
398
8803f07 XSRF prevention in customer/vendor handling added
einhverfr authored
399 sub open_form {
925ed8b Adding option to commit after opening form
einhverfr authored
400 my ($self, $args) = @_;
08b8f24 Correcting open form api for test cases and automation
einhverfr authored
401 if (!$ENV{GATEWAY_INTERFACE}){
402 return 1;
403 }
8803f07 XSRF prevention in customer/vendor handling added
einhverfr authored
404 my @vars = $self->call_procedure(procname => 'form_open',
c88324d Getting rid of 'Invalid Session' errors.
einhverfr authored
405 args => [$self->{session_id}],
406 continue_on_error => 1
8803f07 XSRF prevention in customer/vendor handling added
einhverfr authored
407 );
925ed8b Adding option to commit after opening form
einhverfr authored
408 if ($args->{commit}){
409 $self->{dbh}->commit;
410 }
8803f07 XSRF prevention in customer/vendor handling added
einhverfr authored
411 $self->{form_id} = $vars[0]->{form_open};
412 }
413
414 sub check_form {
415 my ($self) = @_;
416 if (!$ENV{GATEWAY_INTERFACE}){
417 return 1;
418 }
419 my @vars = $self->call_procedure(procname => 'form_check',
420 args => [$self->{session_id}, $self->{form_id}]
421 );
422 return $vars[0]->{form_check};
423 }
424
425 sub close_form {
426 my ($self) = @_;
427 if (!$ENV{GATEWAY_INTERFACE}){
428 return 1;
429 }
430 my @vars = $self->call_procedure(procname => 'form_close',
431 args => [$self->{session_id}, $self->{form_id}]
432 );
433 delete $self->{form_id};
434 return $vars[0]->{form_close};
435 }
436
1335838 User password setting and saving preferences now works (on new codebase)
einhverfr authored
437 sub get_user_info {
438 my ($self) = @_;
439 $self->{_user} = LedgerSMB::User->fetch_config($self);
440 }
276e52f Temporary fix for http auth and get_password
einhverfr authored
441 #This function needs to be moved into the session handler.
70214db Fixing new framework for session and user authentication
einhverfr authored
442 sub _get_password {
426e5a7 session expired/password request screen now uses UI templates
einhverfr authored
443 my ($self) = shift @_;
444 $self->{sessionexpired} = shift @_;
27c5a57 Renaming the Session namespace to LedgerSMB::Auth
einhverfr authored
445 LedgerSMB::Auth::credential_prompt();
426e5a7 session expired/password request screen now uses UI templates
einhverfr authored
446 exit;
70214db Fixing new framework for session and user authentication
einhverfr authored
447 }
448
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
449 sub debug {
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
450 my $self = shift @_;
79cb0d1 Setting things up so that the LedgerSMB.pm tests run
einhverfr authored
451 my $args = shift @_;
452 my $file;
453 if (scalar keys %$args){
50be11c Moving menu.pl to old-handler.pl and adjusting top level scripts acco…
einhverfr authored
454 $file = $args->{'file'};
79cb0d1 Setting things up so that the LedgerSMB.pm tests run
einhverfr authored
455 }
456 my $d = Data::Dumper->new( [$self] );
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
457 $d->Sortkeys(1);
458
459 if ($file) {
460 open( FH, '>', "$file" ) or die $!;
461 print FH $d->Dump();
462 close(FH);
463 }
464 else {
465 print "\n";
466 print $d->Dump();
467 }
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
468
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
469 }
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
470
471 sub escape {
ca7f71b Some bug fixes and tests for LedgerSMB.pm
tetragon authored
472 my $self = shift;
473 my %args = @_;
474 my $str = $args{string};
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
475 $str = "" unless defined $str;
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
476
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
477 my $regex = qr/([^a-zA-Z0-9_.-])/;
478 $str =~ s/$regex/sprintf("%%%02x", ord($1))/ge;
0f9d686 More contact, payment, voucher fixes/enhancements
einhverfr authored
479 return $str;
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
480 }
481
6241ff6 renamed LedgerSMB::callproc to call_procedure. Reworked a number of …
einhverfr authored
482 sub is_blank {
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
483 my $self = shift @_;
484 my %args = @_;
485 my $name = $args{name};
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
486 my $rc;
487
5e02607 Adding missing arg logic stub for LedgerSMB.pm
einhverfr authored
488 if (not defined $name){
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
489 $self->{_locale} = LedgerSMB::Locale->get_handle('en') unless defined $self->{_locale};
490 $self->error($self->{_locale}->text('Field \"Name\" Not Defined'));
5e02607 Adding missing arg logic stub for LedgerSMB.pm
einhverfr authored
491 }
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
492
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
493 if ( $self->{$name} =~ /^\s*$/ ) {
494 $rc = 1;
495 }
496 else {
497 $rc = 0;
498 }
499 $rc;
6241ff6 renamed LedgerSMB::callproc to call_procedure. Reworked a number of …
einhverfr authored
500 }
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
501
119f418 Added LedgerSMB::is_run_mode
einhverfr authored
502 sub is_run_mode {
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
503 my $self = shift @_;
518864d avoid uninitialized warnings in tests
tshvr authored
504 #avoid 'uninitialized' warnings in tests
505 my $mode = shift @_;
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
506 my $rc = 0;
518864d avoid uninitialized warnings in tests
tshvr authored
507 if(! $mode){return $rc;}
508 $mode=lc $mode;
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
509 if ( $mode eq 'cgi' && $ENV{GATEWAY_INTERFACE} ) {
510 $rc = 1;
511 }
512 elsif ( $mode eq 'cli' && !( $ENV{GATEWAY_INTERFACE} || $ENV{MOD_PERL} ) ) {
513 $rc = 1;
514 }
515 elsif ( $mode eq 'mod_perl' && $ENV{MOD_PERL} ) {
516 $rc = 1;
517 }
518 $rc;
119f418 Added LedgerSMB::is_run_mode
einhverfr authored
519 }
520
6241ff6 renamed LedgerSMB::callproc to call_procedure. Reworked a number of …
einhverfr authored
521 sub num_text_rows {
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
522 my $self = shift @_;
523 my %args = @_;
524 my $string = $args{string};
525 my $cols = $args{cols};
526 my $maxrows = $args{max};
527
528 my $rows = 0;
529
530 for ( split /\n/, $string ) {
531 my $line = $_;
532 while ( length($line) > $cols ) {
533 my $fragment = substr( $line, 0, $cols + 1 );
ca7f71b Some bug fixes and tests for LedgerSMB.pm
tetragon authored
534 $fragment =~ s/^(.*)\W.*$/$1/;
535 $line =~ s/$fragment//;
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
536 if ( $line eq $fragment ) { # No word breaks!
537 $line = "";
538 }
539 ++$rows;
540 }
541 ++$rows;
542 }
543
544 if ( !defined $maxrows ) {
545 $maxrows = $rows;
546 }
547
548 return ( $rows > $maxrows ) ? $maxrows : $rows;
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
549
550 }
551
552 sub redirect {
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
553 my $self = shift @_;
554 my %args = @_;
555 my $msg = $args{msg};
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
556
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
557 if ( $self->{callback} || !$msg ) {
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
558
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
559 main::redirect();
50d0e65 Ensuring that $form and $lsmb->redirect terminate
tetragon authored
560 exit;
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
561 }
562 else {
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
563
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
564 $self->info($msg);
565 }
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
566 }
567
fa02f0b Updated LedgerSMB.pm
einhverfr authored
568 # TODO: Either we should have an amount class with formats and such attached
569 # Or maybe we should move this into the user class...
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
570 sub format_amount {
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
571
572 # Based on SQL-Ledger's Form::format_amount
573 my $self = shift @_;
ecf56ec Added format option to LedgerSMB::format_amount
einhverfr authored
574 my %args = (ref($_[0]) eq 'HASH')? %{$_[0]}: @_;
60ef7ef Adding proper dateformat handling to LedgerSMB.pm
einhverfr authored
575 my $myconfig = $args{user} || $self->{_user};
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
576 my $amount = $args{amount};
577 my $places = $args{precision};
578 my $dash = $args{neg_format};
ecf56ec Added format option to LedgerSMB::format_amount
einhverfr authored
579 my $format = $args{format};
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
580
d8e2fd9 PGNumber now passes all number tests.
einhverfr authored
581 if (defined $amount and ! UNIVERSAL::isa($amount, 'LedgerSMB::PGNumber' )) {
27bf0c0 Wiring all number formatting through new amount class PGNumeric
einhverfr authored
582 $amount = $self->parse_amount('user' => $myconfig, 'amount' => $amount);
583 }
584 $dash = undef unless defined $dash;
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
585
ecf56ec Added format option to LedgerSMB::format_amount
einhverfr authored
586 if (!defined $format){
587 $format = $myconfig->{numberformat}
588 }
ddb9bbc Correcting test case failures and handling of undef numbers
einhverfr authored
589 if (!defined $amount){
590 return undef;
591 }
7fad355 Addressing performance issues in multiple payments interface. Adding…
einhverfr authored
592 if (!defined $args{precision} and defined $args{money}){
593 $places = $LedgerSMB::Sysconfig::decimal_places;
594 }
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
595
27bf0c0 Wiring all number formatting through new amount class PGNumeric
einhverfr authored
596 return $amount->to_output({format => $format,
d8e2fd9 PGNumber now passes all number tests.
einhverfr authored
597 neg_format => $args{neg_format},
598 places => $places,
27bf0c0 Wiring all number formatting through new amount class PGNumeric
einhverfr authored
599 money => $args{money},
600 });
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
601 }
602
27bf0c0 Wiring all number formatting through new amount class PGNumeric
einhverfr authored
603 # For backwards compatibility only
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
604 sub parse_amount {
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
605 my $self = shift @_;
606 my %args = @_;
607 my $amount = $args{amount};
d8e2fd9 PGNumber now passes all number tests.
einhverfr authored
608 my $user = ($args{user})? ($args{user}) : $self->{_user};
609 if (UNIVERSAL::isa($amount, 'LedgerSMB::PGNumber')){
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
610 return $amount;
27bf0c0 Wiring all number formatting through new amount class PGNumeric
einhverfr authored
611 }
d8e2fd9 PGNumber now passes all number tests.
einhverfr authored
612 return LedgerSMB::PGNumber->from_input($amount,
613 {format => $user->{numberformat}}
614 );
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
615 }
616
617 sub round_amount {
618
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
619 my ( $self, $amount, $places ) = @_;
9263554 Committing David Mora's rounding fix. May require new lines in ledge…
einhverfr authored
620
621 #
622 # We will grab the default value, if it isnt defined
623 #
417bf84 Correcting failures in t/01 - t/03 test scripts
einhverfr authored
624 if (!defined $places){
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
625 $places = ${LedgerSMB::Sysconfig::decimal_places};
9263554 Committing David Mora's rounding fix. May require new lines in ledge…
einhverfr authored
626 }
627
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
628 # These rounding rules follow from the previous implementation.
629 # They should be changed to allow different rules for different accounts.
a8b15f5 More test coverage of LedgerSMB.pm and re-expression of round_amount
tetragon authored
630 if ($amount >= 0) {
631 Math::BigFloat->round_mode('+inf');
632 }
633 else {
634 Math::BigFloat->round_mode('-inf');
635 }
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
636
a8b15f5 More test coverage of LedgerSMB.pm and re-expression of round_amount
tetragon authored
637 if ($places >= 0) {
638 $amount = Math::BigFloat->new($amount)->ffround( -$places );
639 }
640 else {
641 $amount = Math::BigFloat->new($amount)->ffround( -( $places - 1 ) );
642 }
311db34 Removing one obsolete test, and correcting number handling logic in L…
einhverfr authored
643 $amount->precision(undef);
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
644
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
645 return $amount;
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
646 }
647
6241ff6 renamed LedgerSMB::callproc to call_procedure. Reworked a number of …
einhverfr authored
648 sub call_procedure {
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
649 my $self = shift @_;
650 my %args = @_;
651 my $procname = $args{procname};
81b61ca Finalizing schema support in LedgerSMB.pm.
aurynn_cmd authored
652 my $schema = $args{schema};
bdff086 Moving menu over to new template and stored proc model. THe menu exp…
einhverfr authored
653 my @call_args;
654 @call_args = @{ $args{args} } if defined $args{args};
2aa9246 Added stored procedure collation handling stub
einhverfr authored
655 my $order_by = $args{order_by};
c88324d Getting rid of 'Invalid Session' errors.
einhverfr authored
656 my $query_rc;
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
657 my $argstr = "";
658 my @results;
7dfd737 Correcting (trunk only) SQL injection issue in stored procedure inter…
einhverfr authored
659
24708fa Adding batch_search_mini api
einhverfr authored
660 if (!defined $procname){
661 $self->error('Undefined function in call_procedure.');
662 }
7dfd737 Correcting (trunk only) SQL injection issue in stored procedure inter…
einhverfr authored
663 $procname = $self->{dbh}->quote_identifier($procname);
81b61ca Finalizing schema support in LedgerSMB.pm.
aurynn_cmd authored
664 # Add the test for whether the schema is something useful.
d7af293 added tracing
tshvr authored
665 $logger->trace("\$procname=$procname");
81b61ca Finalizing schema support in LedgerSMB.pm.
aurynn_cmd authored
666
667 $schema = $schema || $LedgerSMB::Sysconfig::db_namespace;
668
669 $schema = $self->{dbh}->quote_identifier($schema);
670
b058513 Sales tax settings now save again in trunk
einhverfr authored
671 for my $arg ( @call_args ) {
672 if (eval { $arg->can('to_db') }){
673 $arg = $arg->to_db;
674 }
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
675 $argstr .= "?, ";
676 }
677 $argstr =~ s/\, $//;
81b61ca Finalizing schema support in LedgerSMB.pm.
aurynn_cmd authored
678 my $query = "SELECT * FROM $schema.$procname()";
2aa9246 Added stored procedure collation handling stub
einhverfr authored
679 if ($order_by){
680 $query .= " ORDER BY $order_by";
681 }
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
682 $query =~ s/\(\)/($argstr)/;
683 my $sth = $self->{dbh}->prepare($query);
5e103cc API Change on LedgerSMB->call_procedure to accommodate bytea's, and a…
einhverfr authored
684 my $place = 1;
685 # API Change here to support byteas:
686 # If the argument is a hashref, allow it to define it's SQL type
687 # for example PG_BYTEA, and use that to bind. The API supports the old
688 # syntax (array of scalars and arrayrefs) but extends this so that hashrefs
689 # now have special meaning. I expect this to be somewhat recursive in the
690 # future if hashrefs to complex types are added, but we will have to put
691 # that off for another day. --CT
692 foreach my $carg (@call_args){
693 if (ref($carg) eq 'HASH'){
f934e96 Bytea's now save correctly
einhverfr authored
694 $sth->bind_param($place, $carg->{value},
695 { pg_type => $carg->{type} });
5e103cc API Change on LedgerSMB->call_procedure to accommodate bytea's, and a…
einhverfr authored
696 } else {
697 $sth->bind_param($place, $carg);
c88324d Getting rid of 'Invalid Session' errors.
einhverfr authored
698 }
5e103cc API Change on LedgerSMB->call_procedure to accommodate bytea's, and a…
einhverfr authored
699 ++$place;
700 }
701 $query_rc = $sth->execute();
702 if (!$query_rc){
703 if ($args{continue_on_error} and # only for plpgsql exceptions
704 ($self->{dbh}->state =~ /^P/)){
705 $@ = $self->{dbh}->errstr;
706 } else {
707 $self->dberror($self->{dbh}->errstr . ": " . $query);
708 }
bdff086 Moving menu over to new template and stored proc model. THe menu exp…
einhverfr authored
709 }
60ef7ef Adding proper dateformat handling to LedgerSMB.pm
einhverfr authored
710
345edc3 Adding type detection so that NUMERIC types from the db are handed of…
einhverfr authored
711 my @types = @{$sth->{TYPE}};
712 my @names = @{$sth->{NAME_lc}};
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
713 while ( my $ref = $sth->fetchrow_hashref('NAME_lc') ) {
345edc3 Adding type detection so that NUMERIC types from the db are handed of…
einhverfr authored
714 for (0 .. $#names){
dbf1efa Get db_parse_numeric to recognise float4/real as a "numeric" type.
tetragon authored
715 # numeric float4/real
716 if ($types[$_] == 3 or $types[$_] == 2) {
a52e9e1 Basic company/credit account stuff now works on new Moose-based classes
einhverfr authored
717 $ref->{$names[$_]} = LedgerSMB::PGNumber->from_db($ref->{$names[$_]}, 'datetime') if defined $ref->{$names[$_]};
345edc3 Adding type detection so that NUMERIC types from the db are handed of…
einhverfr authored
718 }
e9ac6cd modifications for date handling, array handling
einhverfr authored
719 # DATE TIMESTAMP
720 if ($types[$_] == 91 or $types[$_] == 11){
cc2d9bc Framework fixes. Can now log in and edit users in trunk
einhverfr authored
721 $ref->{$names[$_]} = LedgerSMB::PGDate->from_db($ref->{$names[$_]}, 'date') if defined $ref->{$names[$_]};
e9ac6cd modifications for date handling, array handling
einhverfr authored
722 }
345edc3 Adding type detection so that NUMERIC types from the db are handed of…
einhverfr authored
723 }
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
724 push @results, $ref;
725 }
57d4a99 Changes to UI when invoices locked, changes to source numbering behav…
einhverfr authored
726 return @results;
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
727 }
728
dcfdaee Adding role checking function for UI use
einhverfr authored
729 # Keeping this here due to common requirements
730 sub is_allowed_role {
0befab1 Role lookups now working in the application code
einhverfr authored
731 my ($self, $args) = @_;
732 my @roles = @{$args->{allowed_roles}};
4c0d0b7 Adding copy=> and merge=>\@list args to DBObject->new
einhverfr authored
733 for my $role (@roles){
1bb62e6 minor permissions updates for reconciliation
einhverfr authored
734 $self->{_role_prefix} = "lsmb_$self->{company}__" unless defined $self->{_role_prefix};
c0da2bd Role prefix tests pass
einhverfr authored
735 my @roleset = grep m/^$self->{_role_prefix}$role$/, @{$self->{_roles}};
0befab1 Role lookups now working in the application code
einhverfr authored
736 if (scalar @roleset){
dcfdaee Adding role checking function for UI use
einhverfr authored
737 return 1;
738 }
739 }
2cc99c9 New reconciliation report search enhancements
einhverfr authored
740 return 0;
dcfdaee Adding role checking function for UI use
einhverfr authored
741 }
742
b058034 Adding ledgersmb.conf.default
einhverfr authored
743 # This should probably be moved to User too...
744 sub date_to_number {
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
745
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
746 #based on SQL-Ledger's Form::datetonum
747 my $self = shift @_;
748 my %args = @_;
749 my $myconfig = $args{user};
750 my $date = $args{date};
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
751
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
752 $date = "" unless defined $date;
753
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
754 my ( $yy, $mm, $dd );
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
755 if ( $date ne "" && $date && $date =~ /\D/ ) {
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
756
1d0b99e Fixing the real problem behind 1811022
tetragon authored
757 if ( $date =~ /^\d{4}-\d\d-\d\d$/ ) {
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
758 ( $yy, $mm, $dd ) = split /\D/, $date;
1d0b99e Fixing the real problem behind 1811022
tetragon authored
759 } elsif ( $myconfig->{dateformat} =~ /^yy/ ) {
760 ( $yy, $mm, $dd ) = split /\D/, $date;
761 } elsif ( $myconfig->{dateformat} =~ /^mm/ ) {
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
762 ( $mm, $dd, $yy ) = split /\D/, $date;
1d0b99e Fixing the real problem behind 1811022
tetragon authored
763 } elsif ( $myconfig->{dateformat} =~ /^dd/ ) {
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
764 ( $dd, $mm, $yy ) = split /\D/, $date;
765 }
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
766
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
767 $dd *= 1;
768 $mm *= 1;
769 $yy += 2000 if length $yy == 2;
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
770
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
771 $dd = substr( "0$dd", -2 );
772 $mm = substr( "0$mm", -2 );
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
773
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
774 $date = "$yy$mm$dd";
775 }
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
776
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
777 $date;
778 }
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
779
082aada More reconciliaiton issues resolved
einhverfr authored
780 sub sanitize_for_display {
781 my $self = shift;
782 my $var = shift;
783 $self->error('Untested API');
784 if (!$var){
785 $var = $self;
786 }
787 for my $k (keys %$var){
788 my $type = ref($var);
789 if (UNIVERSAL::isa($var->{$k}, 'Math::BigFloat')){
790 $var->{$k} =
791 $self->format_amount({amount => $var->{$k}});
792 }
793 elsif ($type == 'HASH'){
794 $self->sanitize_for_display($var->{$k});
795 }
796 }
797
798 }
799
bffd2ff Replace scattered 'exit;' calls by exception handling,
ehuelsmann authored
800 sub finalize_request {
518864d avoid uninitialized warnings in tests
tshvr authored
801 $logger->debug("throwing CancelFurtherProcessing()");#if trying to follow flow of request
bffd2ff Replace scattered 'exit;' calls by exception handling,
ehuelsmann authored
802 throw CancelFurtherProcessing();
803 }
804
aef6c97 LedgerSMB::error() to be replaced by a simple interface to an error c…
einhverfr authored
805 # To be replaced with a generic interface to an Error class
806 sub error {
807
808 my ( $self, $msg ) = @_;
809
810 if ( $ENV{GATEWAY_INTERFACE} ) {
811
812 $self->{msg} = $msg;
813 $self->{format} = "html";
ed5fbac error routines now log, and log db version and company name. db vers…
einhverfr authored
814 $logger->error($msg);
815 $logger->error("dbversion: $self->{dbversion}, company: $self->{company}");
aef6c97 LedgerSMB::error() to be replaced by a simple interface to an error c…
einhverfr authored
816
817 delete $self->{pre};
818
ad8fbf5 If no login sent, return simple credential-free object
einhverfr authored
819
820 print qq|Content-Type: text/html; charset=utf-8\n\n|;
a58c1e6 Correcting stylesheet not set on error pages for new code
einhverfr authored
821 print "<head><link rel='stylesheet' href='css/$self->{_user}->{stylesheet}' type='text/css'></head>";
e583c13 user management now works, needs some documentation
einhverfr authored
822 $self->{msg} =~ s/\n/<br \/>\n/;
aef6c97 LedgerSMB::error() to be replaced by a simple interface to an error c…
einhverfr authored
823 print
ed5fbac error routines now log, and log db version and company name. db vers…
einhverfr authored
824 qq|<body><h2 class="error">Error!</h2> <p><b>$self->{msg}</b></p>
825 <p>dbversion: $self->{dbversion}, company: $self->{company}</p>
826 </body>|;
aef6c97 LedgerSMB::error() to be replaced by a simple interface to an error c…
einhverfr authored
827
828 exit;
829
830 }
831 else {
832
833 if ( $ENV{error_function} ) {
834 &{ $ENV{error_function} }($msg);
835 }
836 die "Error: $msg\n";
837 }
838 }
c72bdb0 Deleted unnecessary functions from LedgerSMB.pm so we don't become de…
einhverfr authored
839 # Database routines used throughout
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
840
a51eb1d Correcting POD on LedgerSMB.pm, changing db_init to _db_init and call…
einhverfr authored
841 sub _db_init {
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
842 my $self = shift @_;
843 my %args = @_;
1d020d5 better handling of successive logouts,set default locale earlier so o…
tshvr authored
844 (my $package,my $filename,my $line)=caller;
845 if($self->{dbh})
846 {
847 $logger->error("dbh already set \$self->{dbh}=$self->{dbh},called from $filename");
848 }
1bf55c0 One can now set taxes for customers/vendors
einhverfr authored
849
1d020d5 better handling of successive logouts,set default locale earlier so o…
tshvr authored
850 my $creds = LedgerSMB::Auth::get_credentials();
01556e1 Moving Auth functions into Session handler
einhverfr authored
851
852 $self->{login} = $creds->{login};
31d92e4 More authentication fixes.
einhverfr authored
853 if (!$self->{company}){
854 $self->{company} = $LedgerSMB::Sysconfig::default_db;
855 }
2c60683 Login is still broken. However, a lot of progress has been made. TH…
einhverfr authored
856 my $dbname = $self->{company};
857
858 # Note that we have to request the login/password again if the db
859 # connection fails since this probably means bad credentials are entered.
860 # Just in case, however, I think it is a good idea to include the DBI
861 # error string. CT
3c8bf66 Authetication now works as far as the root document
einhverfr authored
862 $self->{dbh} = DBI->connect(
01556e1 Moving Auth functions into Session handler
einhverfr authored
863 "dbi:Pg:dbname=$dbname", "$creds->{login}", "$creds->{password}", { AutoCommit => 0 }
2c60683 Login is still broken. However, a lot of progress has been made. TH…
einhverfr authored
864 );
1d020d5 better handling of successive logouts,set default locale earlier so o…
tshvr authored
865 $logger->debug("DBI->connect dbh=$self->{dbh}");
eefc011 DBI trace
tshvr authored
866 my $dbi_trace=$LedgerSMB::Sysconfig::DBI_TRACE;
867 if($dbi_trace)
868 {
869 $logger->debug("\$dbi_trace=$dbi_trace");
870 $self->{dbh}->trace(split /=/,$dbi_trace,2);#http://search.cpan.org/~timb/DBI-1.616/DBI.pm#TRACING
871 }
2c60683 Login is still broken. However, a lot of progress has been made. TH…
einhverfr authored
872
873
3c8bf66 Authetication now works as far as the root document
einhverfr authored
874 if (($self->{script} eq 'login.pl') && ($self->{action} eq
875 'authenticate')){
29831de let LedgerSMB reuse already acquired dbh-handle,avoid msg:Issuing rol…
tshvr authored
876 if (!$self->{dbh}){
c360142 Provisional handling of database not found errors separate from auth …
einhverfr authored
877 $self->{_auth_error} = $DBI::errstr;
878 }
2c60683 Login is still broken. However, a lot of progress has been made. TH…
einhverfr authored
879 return;
880 }
29831de let LedgerSMB reuse already acquired dbh-handle,avoid msg:Issuing rol…
tshvr authored
881 elsif (!$self->{dbh}){
2c60683 Login is still broken. However, a lot of progress has been made. TH…
einhverfr authored
882 $self->_get_password;
883 }
29831de let LedgerSMB reuse already acquired dbh-handle,avoid msg:Issuing rol…
tshvr authored
884 $self->{dbh}->{pg_server_prepare} = 0;
885 $self->{dbh}->{pg_enable_utf8} = 1;
00c6d34 Adding centralized db commits when sending HTTP output
einhverfr authored
886 $LedgerSMB::App_State::DBH = $self->{dbh};
0e0da8e turning off server-side prepare in new code because it won't buy us a…
einhverfr authored
887
ab00ae9 A few authentication fixes
einhverfr authored
888 # This is the general version check
29831de let LedgerSMB reuse already acquired dbh-handle,avoid msg:Issuing rol…
tshvr authored
889 my $sth = $self->{dbh}->prepare("
ab00ae9 A few authentication fixes
einhverfr authored
890 SELECT value FROM defaults
891 WHERE setting_key = 'version'");
892 $sth->execute;
893 my ($dbversion) = $sth->fetchrow_array;
29831de let LedgerSMB reuse already acquired dbh-handle,avoid msg:Issuing rol…
tshvr authored
894 $sth = $self->{dbh}->prepare("
c0da2bd Role prefix tests pass
einhverfr authored
895 SELECT value FROM defaults
896 WHERE setting_key = 'role_prefix'");
897 $sth->execute;
ed75955 Session/password expiration now works in theory (needs more testing),…
einhverfr authored
898
899
c0da2bd Role prefix tests pass
einhverfr authored
900 ($self->{_role_prefix}) = $sth->fetchrow_array;
ab00ae9 A few authentication fixes
einhverfr authored
901 if ($dbversion ne $self->{dbversion}){
6425c12 Final commit for 1.3.4:
einhverfr authored
902 $self->error("Database is not the expected version. Was $dbversion, expected $self->{dbversion}. Please re-run setup.pl against this database to correct.");
ab00ae9 A few authentication fixes
einhverfr authored
903 }
904
29831de let LedgerSMB reuse already acquired dbh-handle,avoid msg:Issuing rol…
tshvr authored
905 $sth = $self->{dbh}->prepare('SELECT check_expiration()');
ed75955 Session/password expiration now works in theory (needs more testing),…
einhverfr authored
906 $sth->execute;
907 ($self->{warn_expire}) = $sth->fetchrow_array;
908
909 if ($self->{warn_expire}){
29831de let LedgerSMB reuse already acquired dbh-handle,avoid msg:Issuing rol…
tshvr authored
910 $sth = $self->{dbh}->prepare('SELECT user__check_my_expiration()');
ed75955 Session/password expiration now works in theory (needs more testing),…
einhverfr authored
911 $sth->execute;
912 ($self->{pw_expires}) = $sth->fetchrow_array;
913 }
ab00ae9 A few authentication fixes
einhverfr authored
914
915
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
916 my $query = "SELECT t.extends,
c72bdb0 Deleted unnecessary functions from LedgerSMB.pm so we don't become de…
einhverfr authored
917 coalesce (t.table_name, 'custom_' || extends)
918 || ':' || f.field_name as field_def
919 FROM custom_table_catalog t
920 JOIN custom_field_catalog f USING (table_id)";
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
921 $sth = $self->{dbh}->prepare($query);
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
922 $sth->execute;
923 my $ref;
7a264f0 Fixed assets permissions issues
einhverfr authored
924 $self->{custom_db_fields} = {};
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
925 while ( $ref = $sth->fetchrow_hashref('NAME_lc') ) {
7a264f0 Fixed assets permissions issues
einhverfr authored
926 push @{ $self->{custom_db_fields}->{ $ref->{extends} } },
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
927 $ref->{field_def};
928 }
0befab1 Role lookups now working in the application code
einhverfr authored
929
930 # Adding role list to self
931 $self->{_roles} = [];
932 $query = "select rolname from pg_roles
933 where pg_has_role(SESSION_USER, 'USAGE')";
29831de let LedgerSMB reuse already acquired dbh-handle,avoid msg:Issuing rol…
tshvr authored
934 $sth = $self->{dbh}->prepare($query);
0befab1 Role lookups now working in the application code
einhverfr authored
935 $sth->execute();
936 while (my @roles = $sth->fetchrow_array){
937 push @{$self->{_roles}}, $roles[0];
938 }
29831de let LedgerSMB reuse already acquired dbh-handle,avoid msg:Issuing rol…
tshvr authored
939 $sth->finish();
bbb4b26 only logging changes
tshvr authored
940 $logger->debug("end");
c72bdb0 Deleted unnecessary functions from LedgerSMB.pm so we don't become de…
einhverfr authored
941 }
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
942
e355b40 John Worsley's Ajax handling for GL reports
einhverfr authored
943 #private, for db connection errors
944 sub _on_connection_error {
945 for (@_){
1bf55c0 One can now set taxes for customers/vendors
einhverfr authored
946 $logger->error("$_");
e355b40 John Worsley's Ajax handling for GL reports
einhverfr authored
947 }
948 }
949
c2f3e31 Some voucher fixes
einhverfr authored
950 sub dberror{
951 my $self = shift @_;
96769e3 Correcting bug 3415320, patch submitted by Herman Vierendeels
einhverfr authored
952 my $state_error = {};
953 if ($self->{_locale}){
954 my $state_error = {
955 '42883' => $self->{_locale}->text('Internal Database Error'),
956 '42501' => $self->{_locale}->text('Access Denied'),
957 '42401' => $self->{_locale}->text('Access Denied'),
958 '22008' => $self->{_locale}->text('Invalid date/time entered'),
959 '22012' => $self->{_locale}->text('Division by 0 error'),
960 '22004' => $self->{_locale}->text('Required input not provided'),
961 '23502' => $self->{_locale}->text('Required input not provided'),
962 '23505' => $self->{_locale}->text('Conflict with Existing Data'),
963 'P0001' => $self->{_locale}->text('Error from Function:') . "\n" .
e583c13 user management now works, needs some documentation
einhverfr authored
964 $self->{dbh}->errstr,
96769e3 Correcting bug 3415320, patch submitted by Herman Vierendeels
einhverfr authored
965 };
966 }
1bf55c0 One can now set taxes for customers/vendors
einhverfr authored
967 $logger->error("Logging SQL State ".$self->{dbh}->state.", error ".
968 $self->{dbh}->err . ", string " .$self->{dbh}->errstr);
e583c13 user management now works, needs some documentation
einhverfr authored
969 if (defined $state_error->{$self->{dbh}->state}){
3afe67f improvement to db-trapped error handling
einhverfr authored
970 $self->error($state_error->{$self->{dbh}->state}
971 . "\n" .
972 $self->{_locale}->text('More information has been reported in the error logs'));
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
973 $self->{dbh}->rollback;
e583c13 user management now works, needs some documentation
einhverfr authored
974 exit;
634b51e Ensuring that new transactions are detected on update, for unsubmitte…
einhverfr authored
975 }
976 $self->error($self->{dbh}->state . ":" . $self->{dbh}->errstr);
c2f3e31 Some voucher fixes
einhverfr authored
977 }
978
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
979 sub redo_rows {
980
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
981 my $self = shift @_;
982 my %args = @_;
983 my @flds = @{ $args{fields} };
984 my $count = $args{count};
985 my $index = ( $args{index} ) ? $args{index} : 'runningnumber';
986
987 my @rows;
c98fa42 Committing Alexey's patch for Safari and authentication
einhverfr authored
988 my $i; # increment counter use only
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
989 for $i ( 1 .. $count ) {
990 my $temphash = { _inc => $i };
991 for my $fld (@flds) {
992 $temphash->{$fld} = $self->{ "$fld" . "_$i" };
993 }
994 push @rows, $temphash;
995 }
996 $i = 1;
c98fa42 Committing Alexey's patch for Safari and authentication
einhverfr authored
997 for my $row ( sort { $a->{$index} <=> $b->{$index} } @rows ) {
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
998 for my $fld (@flds) {
999 $self->{ "$fld" . "_$i" } = $row->{$fld};
1000 }
1001 ++$i;
1002 }
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
1003 }
1004
36dff6b refactoring some methods and getting rid of unnecessary multiple inhe…
einhverfr authored
1005 sub merge {
bbb4b26 only logging changes
tshvr authored
1006 (my $package,my $filename,my $line)=caller;
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
1007 my ( $self, $src ) = @_;
c5cc478 Reduced warnings in the logs
einhverfr authored
1008 $logger->debug("begin caller \$filename=$filename \$line=$line");
1009 # Removed dbh from logging string since not used on this api call and
1010 # not initialized in test cases -CT
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
1011 for my $arg ( $self, $src ) {
1012 shift;
1013 }
1014 my %args = @_;
6b9ed8b Fixing Merge so that @keys is truly optional
einhverfr authored
1015 my @keys;
1016 if (defined $args{keys}){
1017 @keys = @{ $args{keys} };
1018 }
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
1019 my $index = $args{index};
1020 if ( !scalar @keys ) {
1021 @keys = keys %{$src};
1022 }
4a86427 Fixes for merge and more tests
tetragon authored
1023 for my $arg ( @keys ) {
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
1024 my $dst_arg;
1025 if ($index) {
1026 $dst_arg = $arg . "_$index";
1027 }
1028 else {
1029 $dst_arg = $arg;
1030 }
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
1031 if ( defined $dst_arg && defined $src->{$arg} )
1032 {
bbb4b26 only logging changes
tshvr authored
1033 $logger->trace("LedgerSMB.pm: merge setting $dst_arg to $src->{$arg}");
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
1034 }
1035 elsif ( !defined $dst_arg && defined $src->{$arg} )
1036 {
bbb4b26 only logging changes
tshvr authored
1037 $logger->trace("LedgerSMB.pm: merge setting \$dst_arg is undefined \$src->{\$arg} is defined $src->{$arg}");
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
1038 }
1039 elsif ( defined $dst_arg && !defined $src->{$arg} )
1040 {
bbb4b26 only logging changes
tshvr authored
1041 $logger->trace("LedgerSMB.pm: merge setting \$dst_arg is defined $dst_arg \$src->{\$arg} is undefined");
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
1042 }
1043 elsif ( !defined $dst_arg && !defined $src->{$arg} )
1044 {
bbb4b26 only logging changes
tshvr authored
1045 $logger->trace("LedgerSMB.pm: merge setting \$dst_arg is undefined \$src->{\$arg} is undefined");
99fa611 Lacey's patches for cleaning up test cases
einhverfr authored
1046 }
666fd83 Doing a simple Perltidy commit so that I can evaluate differences bet…
einhverfr authored
1047 $self->{$dst_arg} = $src->{$arg};
1048 }
c5cc478 Reduced warnings in the logs
einhverfr authored
1049 $logger->debug("end caller \$filename=$filename \$line=$line");
36dff6b refactoring some methods and getting rid of unnecessary multiple inhe…
einhverfr authored
1050 }
1051
5f24c10 Removal of extra new_user function from admin.pl.
aurynn_cmd authored
1052 sub type {
1053
1054 my $self = shift @_;
1055
1056 if (!$ENV{REQUEST_METHOD} or
84b3533 Disabled login checking in LedgerSMB.pm, temporarily.
aurynn_cmd authored
1057 ( !grep {$ENV{REQUEST_METHOD} eq $_} ("HEAD", "GET", "POST") ) ) {
5f24c10 Removal of extra new_user function from admin.pl.
aurynn_cmd authored
1058
1059 $self->error("Request method unset or set to unknown value");
1060 }
1061
1062 return $ENV{REQUEST_METHOD};
1063 }
1064
1065 sub DESTROY {}
1066
1151179 Moving Aurynn's set() function from DBObject to LedgerSMB namespaces …
einhverfr authored
1067 sub set {
1068
1069 my $self = shift @_;
1070 my %args = @_;
1071
1072 for my $arg (keys(%args)) {
1073 $self->{$arg} = $args{$arg};
1074 }
1075 return 1;
1076
1077 }
1078
03bfa82 Added a routine to sanitize the CGI variables. Needed for some CSV e…
einhverfr authored
1079 sub remove_cgi_globals {
1080 my ($self) = @_;
1081 for my $key (keys %$self){
1082 if ($key =~ /^\./){
1083 delete $self->{key}
1084 }
1085 }
1086 }
0f9d686 More contact, payment, voucher fixes/enhancements
einhverfr authored
1087
1088 sub take_top_level {
1089 my ($self) = @_;
1090 my $return_hash = {};
1091 for my $key (keys %$self){
1092 if (!ref($self->{$key}) && $key !~ /^\./){
1093 $return_hash->{$key} = $self->{$key}
1094 }
1095 }
1096 return $return_hash;
1097 }
1098
945d972 David Mora's overpayment fixes
einhverfr authored
1099
1100
1101 sub get_default_value_by_key
1102 {
1103 my ($self, $key) = @_;
1104 my $Settings = LedgerSMB::Setting->new({base => $self, copy => 'base'});
1105 $Settings->{key} = $key;
1106 $Settings->get;
1107 $Settings->{value};
1108 }
f02f244 First draft of DBObject and LedgerSMB namespace
einhverfr authored
1109 1;
ca7f71b Some bug fixes and tests for LedgerSMB.pm
tetragon authored
1110
1d0b99e Fixing the real problem behind 1811022
tetragon authored
1111
Something went wrong with that request. Please try again.