diff options
| -rw-r--r-- | LedgerSMB/User.pm | 234 |
1 files changed, 202 insertions, 32 deletions
diff --git a/LedgerSMB/User.pm b/LedgerSMB/User.pm index f38251a0..f67ad9c4 100644 --- a/LedgerSMB/User.pm +++ b/LedgerSMB/User.pm @@ -1,41 +1,72 @@ -#===================================================================== -# LedgerSMB -# Small Medium Business Accounting software -# http://www.ledgersmb.org/ -# -# Copyright (C) 2006 -# This work contains copyrighted information from a number of sources all used -# with permission. -# -# This file contains source code included with or based on SQL-Ledger which -# is Copyright Dieter Simader and DWS Systems Inc. 2000-2005 and licensed -# under the GNU General Public License version 2 or, at your option, any later -# version. For a full list including contact information of contributors, -# maintainers, and copyright holders, see the CONTRIBUTORS file. -# -# Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork): -# Copyright (C) 2000 -# -# Author: DWS Systems Inc. -# Web: http://www.sql-ledger.org -# -# Contributors: Jim Rawlings <jim@your-dba.com> -# -#====================================================================== -# -# This file has undergone whitespace cleanup. -# -#====================================================================== -# -# user related functions -# -#===================================================================== + +=head1 NAME + +LedgerSMB::User + +=head1 SYNOPSIS + +This module provides user support and database management functions. + +=head1 STATUS + +Deprecated + +=head1 COPYRIGHT + + #==================================================================== + # LedgerSMB + # Small Medium Business Accounting software + # http://www.ledgersmb.org/ + # + # Copyright (C) 2006 + # This work contains copyrighted information from a number of sources + # all used with permission. + # + # This file contains source code included with or based on SQL-Ledger + # which is Copyright Dieter Simader and DWS Systems Inc. 2000-2005 + # and licensed under the GNU General Public License version 2 or, at + # your option, any later version. For a full list including contact + # information of contributors, maintainers, and copyright holders, + # see the CONTRIBUTORS file. + # + # Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork): + # Copyright (C) 2000 + # + # Author: DWS Systems Inc. + # Web: http://www.sql-ledger.org + # + # Contributors: Jim Rawlings <jim@your-dba.com> + # + #==================================================================== + # + # This file has undergone whitespace cleanup. + # + #==================================================================== + # + # user related functions + # + #==================================================================== + +=head1 METHODS + +=over + +=cut + +# inline documentation package LedgerSMB::User; use LedgerSMB::Sysconfig; use LedgerSMB::Session; use Data::Dumper; +=item LedgerSMB::User->new($login); + +Create a LedgerSMB::User object. If the user $login exists, set the fields +with values retrieved from the database. + +=cut + sub new { my ( $type, $login ) = @_; @@ -89,6 +120,13 @@ sub new { bless $self, $type; } +=item LedgerSMB::User->country_codes(); + +Returns a hash where the keys are registered locales and the values are the +textual representation of the locale name. + +=cut + sub country_codes { use Locale::Country; use Locale::Language; @@ -114,6 +152,14 @@ sub country_codes { } +=item LedgerSMB::User->fetch_config($login); + +Returns a reference to a hash that contains the user config for the user $login. +If that user does not exist, output 'Access denied' if in CGI and die in all +cases. + +=cut + sub fetch_config { #I'm hoping that this function will go and is a temporary bridge @@ -170,6 +216,12 @@ sub fetch_config { return \%myconfig; } +=item $user->login($form); + +Disused auth function. + +=cut + sub login { my ( $self, $form ) = @_; @@ -258,6 +310,12 @@ sub login { } +=item LedgerSMB::User->check_recurring($form); + +Disused function to return the number of current recurring events. + +=cut + sub check_recurring { my ( $self, $form ) = @_; @@ -277,6 +335,12 @@ sub check_recurring { } +=item LedgerSMB::User::dbconnect_vars($form, $db); + +Converts individual $form values into $form->{dboptions} and $form->{dbconnect}. + +=cut + sub dbconnect_vars { my ( $form, $db ) = @_; @@ -299,6 +363,12 @@ sub dbconnect_vars { } +=item LedgerSMB::User->dbdrivers(); + +Returns a list of all drivers set up with DBI whose names end in 'Pg'. + +=cut + sub dbdrivers { my @drivers = DBI->available_drivers(); @@ -308,6 +378,14 @@ sub dbdrivers { } +=item LedgerSMB::User->dbsources($form); + +Returns a list of all databases in the same cluster as the database that $form +is set to. If $form->{only_acc_db} is set, only non-template databases that +have a defaults table owned by $form->{dbuser} are returned. + +=cut + sub dbsources { my ( $self, $form ) = @_; @@ -368,6 +446,14 @@ sub dbsources { } +=item LedgerSMB::User->dbcreate($form); + +Create the database indicated by $form->{db} and load Pg-database.sql, the chart +indicated by $form->{chart} and custom tables and functions +(Pg-custom_tables.sql and Pg-custom_functions). + +=cut + sub dbcreate { my ( $self, $form ) = @_; @@ -449,6 +535,13 @@ sub dbcreate { } +=item LedgerSMB::User->process_query($form, $dbh, $filename); + +Load the file $filename into the database indicated through form using psql. +$dbh is ignored. + +=cut + sub process_query { my ( $self, $form, $dbh, $filename ) = @_; @@ -469,6 +562,12 @@ sub process_query { } } +=item LedgerSMB::User->dbdelete($form); + +Disused function to drop the database $form->{db}. + +=cut + sub dbdelete { my ( $self, $form ) = @_; @@ -485,6 +584,13 @@ sub dbdelete { } +=item LedgerSMB::User->dbsources_unused($form, $memfile); + +Disused function to identify all databases in a cluster with a defaults table +that are not mentioned in the memberfile $memfile. + +=cut + sub dbsources_unused { my ( $self, $form, $memfile ) = @_; @@ -522,6 +628,13 @@ sub dbsources_unused { } +=item LedgerSMB::User->dbneedsupdate($form); + +Disused function to locate all databases owned by $form->{dbuser} that are not +a template* database which have a defaults table with a version entry. + +=cut + sub dbneedsupdate { my ( $self, $form ) = @_; @@ -591,6 +704,12 @@ sub dbneedsupdate { } +=item LedgerSMB::User->dbupdate($form); + +Applies database upgrade scripts to upgrade the database to the current level. + +=cut + sub dbupdate { my ( $self, $form ) = @_; @@ -671,6 +790,23 @@ sub dbupdate { } +=item calc_version($version); + +Returns a numeric form for the version passed in. The numeric form is derived +by converting each dotted portion of the version to a three-digit number and +appending them. + + +----------+------------+ + | $version | returned | + +----------+------------+ + | 1.0.0 | 1000000 | + | 1.2.33 | 1002033 | + | 189.2.33 | 189002033 | + | 1.2.3.4 | 1002003004 | + +----------+------------+ + +=cut + sub calc_version { my @v = split /\./, $_[0]; @@ -686,6 +822,12 @@ sub calc_version { } +=item script_version + +Sorting function for database upgrade scripts. + +=cut + sub script_version { my ( $my_a, $my_b ) = ( $a, $b ); @@ -711,6 +853,13 @@ sub script_version { } +=item $user->save_member(); + +Updates the user config in the database for the user $user. If no config for +the user exists, the user to the database. + +=cut + sub save_member { my ($self) = @_; @@ -900,6 +1049,12 @@ sub save_member { } } +=item LedgerSMB::User->delete_login($form); + +Disused function to delete the user $form->{login}. + +=cut + sub delete_login { my ( $self, $form ) = @_; @@ -931,6 +1086,12 @@ sub delete_login { } +=item LedgerSMB::User->config_vars(); + +Disused function that returns a list of user config variable names. + +=cut + sub config_vars { my @conf = qw(acs address businessnumber company countrycode @@ -943,6 +1104,13 @@ sub config_vars { } +=item $self->error($msg); + +Privately used error function. Used in places where the more typically used +$form->error cannot be used. Always dies. + +=cut + sub error { my ( $self, $msg ) = @_; @@ -960,3 +1128,5 @@ sub error { 1; +=back + |