diff options
author | christopherm <christopherm@4979c152-3d1c-0410-bac9-87ea11338e46> | 2006-11-03 05:13:21 +0000 |
---|---|---|
committer | christopherm <christopherm@4979c152-3d1c-0410-bac9-87ea11338e46> | 2006-11-03 05:13:21 +0000 |
commit | 3ad50effa2b0caa4ee742ca6e30a70cbe1077878 (patch) | |
tree | 9d9f632e753990e81d2c2e8f9d89de466fef0ba4 /LedgerSMB | |
parent | aadceb81a6b63a1896b3150a4f6783bcc45a1157 (diff) |
moving all user preferences into the central db. This will break current test installs or anyone running HEAD. Please see ledger-smb.conf. You will also need to create the central db (using Pg-central.sql) and set the admin user password (md5(something)). More info to be given on the legdger-smb-devel mailing list
git-svn-id: https://ledger-smb.svn.sourceforge.net/svnroot/ledger-smb/trunk@479 4979c152-3d1c-0410-bac9-87ea11338e46
Diffstat (limited to 'LedgerSMB')
-rwxr-xr-x | LedgerSMB/AM.pm | 4 | ||||
-rwxr-xr-x | LedgerSMB/Session/DB.pm | 32 | ||||
-rwxr-xr-x | LedgerSMB/User.pm | 337 |
3 files changed, 193 insertions, 180 deletions
diff --git a/LedgerSMB/AM.pm b/LedgerSMB/AM.pm index a8fd1e63..a066f9af 100755 --- a/LedgerSMB/AM.pm +++ b/LedgerSMB/AM.pm @@ -1335,7 +1335,7 @@ sub save_preferences { $dbh->commit; - my $myconfig = LedgerSMB::User->new("${LedgerSMB::Sysconfig::memberfile}", "$form->{login}"); + my $myconfig = LedgerSMB::User->new($form->{login}); foreach my $item (keys %$form) { $myconfig->{$item} = $form->{$item}; @@ -1343,7 +1343,7 @@ sub save_preferences { $myconfig->{password} = $form->{new_password} if ($form->{old_password} ne $form->{new_password}); - $myconfig->save_member(${LedgerSMB::Sysconfig::memberfile}, ${LedgerSMB::Sysconfig::userspath}); + $myconfig->save_member(); 1; diff --git a/LedgerSMB/Session/DB.pm b/LedgerSMB/Session/DB.pm index 7b59a718..1f215b13 100755 --- a/LedgerSMB/Session/DB.pm +++ b/LedgerSMB/Session/DB.pm @@ -28,11 +28,11 @@ package Session; sub session_check { - my ($cookie, $form, %myconfig) = @_; + my ($cookie, $form) = @_; my ($sessionid, $token) = split /:/, $cookie; - # connect to database - my $dbh = DBI->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd}); + # use the central database handle + my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; my $checkQuery = $dbh->prepare("SELECT sl_login FROM session WHERE session_id = ? AND token = ? AND last_used > now() - ?::interval"); @@ -53,7 +53,7 @@ sub session_check { } $checkQuery->execute($sessionid, $token, $timeout) - || $form->dberror('Looking for session: '); + || $form->dberror(__FILE__.':'.__LINE__.': Looking for session: '); my $sessionValid = $checkQuery->rows; if($sessionValid){ @@ -65,7 +65,7 @@ sub session_check { $login =~ s/[^a-zA-Z0-9@.-]//g; if($sessionLogin eq $login){ - $updateAge->execute($sessionid) || $form->dberror('Updating session age: '); + $updateAge->execute($sessionid) || $form->dberror(__FILE__.':'.__LINE__.': Updating session age: '); return 1; } else { @@ -85,10 +85,10 @@ sub session_check { } sub session_create { - my ($form, %myconfig) = @_; + my ($form) = @_; - # connect to database - my $dbh = DBI->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd}); + # use the central database handle + my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; # TODO Change this to use %myconfig my $deleteExisting = $dbh->prepare("DELETE FROM session WHERE sl_login = ? AND age(last_used) > ?::interval"); @@ -110,19 +110,19 @@ sub session_create { $myconfig{timeout} = 86400; } - $deleteExisting->execute($login, "$myconfig{timeout} seconds") || $form->dberror('Delete from session: '); + $deleteExisting->execute($login, "$myconfig{timeout} seconds") || $form->dberror(__FILE__.':'.__LINE__.': Delete from session: '); #doing the md5 and random stuff in the db so that LedgerSMB won't #require new perl modules (Digest::MD5 and a good random generator) - $fetchSequence->execute() || $form->dberror('Fetch sequence id: '); + $fetchSequence->execute() || $form->dberror(__FILE__.':'.__LINE__.': Fetch sequence id: '); my ($newSessionID, $newToken) = $fetchSequence->fetchrow_array; #create a new session - $createNew->execute($newSessionID, $login, $newToken) || $form->dberror('Create new session: '); + $createNew->execute($newSessionID, $login, $newToken) || $form->dberror(__FILE__.':'.__LINE__.': Create new session: '); #reseed the random number generator my $randomSeed = 1.0 * ('0.'. (time() ^ ($$ + ($$ <<15)))); - $seedRandom->execute($randomSeed)|| $form->dberror('Reseed random generator: ');; + $seedRandom->execute($randomSeed)|| $form->dberror(__FILE__.':'.__LINE__.': Reseed random generator: '); $newCookieValue = $newSessionID . ':' . $newToken; @@ -139,16 +139,16 @@ sub session_destroy { # which means that the db connection parameters are not available. # moving user prefs and the session table into a central db will solve this issue - my ($form, %myconfig) = @_; + my ($form) = @_; my $login = $form->{login}; $login =~ s/[^a-zA-Z0-9@.-]//g; - # connect to database - my $dbh = DBI->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd}); + # use the central database handle + my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; my $deleteExisting = $dbh->prepare("DELETE FROM session WHERE sl_login = ?;"); - $deleteExisting->execute($login) || $form->dberror('Delete from session: '); + $deleteExisting->execute($login) || $form->dberror(__FILE__.':'.__LINE__.': Delete from session: '); #delete the cookie in the browser print qq|Set-Cookie: LedgerSMB=; path=/;\n|; diff --git a/LedgerSMB/User.pm b/LedgerSMB/User.pm index 67249a04..18f4e8d9 100755 --- a/LedgerSMB/User.pm +++ b/LedgerSMB/User.pm @@ -33,47 +33,47 @@ package LedgerSMB::User; use LedgerSMB::Sysconfig; - +use Data::Dumper; sub new { - my ($type, $memfile, $login) = @_; + + my ($type, $login) = @_; my $self = {}; if ($login ne "") { - &error("", "$memfile locked!") if (-f "${memfile}.LCK"); - - open(MEMBER, "$memfile") or &error("", "$memfile : $!"); - - while (<MEMBER>) { - if (/^\[$login\]/) { - while (<MEMBER>) { - last if /^\[/; - next if /^(#|\s)/; - - # remove comments - - s/^\s*#.*//g; - # remove any trailing whitespace - s/^\s*(.*?)\s*$/$1/; + # use central db + my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; + + # for now, this is querying the table directly... ugly + my $fetchUserPrefs = $dbh->prepare("SELECT acs, address, businessnumber, + company, countrycode, currency, + dateformat, dbconnect, dbdriver, + dbhost, dbname, dboptions, dbpasswd, + dbport, dbuser, email, fax, menuwidth, + name, numberformat, password, print, + printer, role, sid, signature, stylesheet, + tel, templates, timeout, vclimit, u.username + FROM users_conf as uc, users as u + WHERE u.username = ? + AND u.id = uc.id;"); - ($key, $value) = split /=/, $_, 2; - - $self->{$key} = $value; - } - - $self->{login} = $login; + $fetchUserPrefs->execute($login); - last; - } + my $userHashRef = $fetchUserPrefs->fetchrow_hashref; + + while ( my ($key, $value) = each(%{$userHashRef}) ) { + $self->{$key} = $value; + } + + if($self->{username}){ + $self->{login} = $login; } - close MEMBER; } bless $self, $type; } - sub country_codes { use Locale::Country; use Locale::Language; @@ -99,43 +99,71 @@ sub country_codes { } +sub fetch_config { +#I'm hoping that this function will go and is a temporary bridge +#until we get rid of %myconfig elsewhere in the code + + my ($self, $login) = @_; + + if ($login ne "") { + + # use central db + my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; + + # for now, this is querying the table directly... ugly + my $fetchUserPrefs = $dbh->prepare("SELECT acs, address, businessnumber, + company, countrycode, currency, + dateformat, dbconnect, dbdriver, + dbhost, dbname, dboptions, dbpasswd, + dbport, dbuser, email, fax, menuwidth, + name, numberformat, password, print, + printer, role, sid, signature, stylesheet, + tel, templates, timeout, vclimit + FROM users_conf as uc, users as u + WHERE u.username = ? + AND u.id = uc.id;"); + + $fetchUserPrefs->execute($login); + + my $userHashRef = $fetchUserPrefs->fetchrow_hashref; + + while ( my ($key, $value) = each(%{$userHashRef}) ) { + $myconfig{$key} = $value; + } + } + + return \%myconfig; +} sub login { + use Digest::MD5; + my ($self, $form) = @_; my $rc = -1; if ($self->{login} ne "") { + if ($self->{password} ne (Digest::MD5::md5_hex $form->{password}) ) { + return -1; + } - if ($self->{password} ne "") { - my $password = - crypt $form->{password}, - substr($self->{login}, 0, 2); - if ($self->{password} ne $password) { - return -1; - } + #this is really dumb, but %myconfig will have to stay until 1.3 + while ( my ($key, $value) = each(%{$self}) ) { + $myconfig{$key} = $value; } - - #there shouldn't be any harm in always doing this. - #It might even un-bork things. - $self->create_config( - "${LedgerSMB::Sysconfig::userspath}/$self->{login}.conf"); - - do "${LedgerSMB::Sysconfig::userspath}/$self->{login}.conf"; - $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; - + # check if database is down my $dbh = DBI->connect( $myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd}) - or $self->error($DBI::errstr); + or $self->error(__FILE__.':'.__LINE__.': '.$DBI::errstr); # we got a connection, check the version my $query = qq| SELECT value FROM defaults WHERE setting_key = 'version'|; my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth->execute || $form->dberror(__FILE__.':'.__LINE__.$query); my ($dbversion) = $sth->fetchrow_array; $sth->finish; @@ -195,11 +223,9 @@ sub login { sub check_recurring { my ($self, $form) = @_; - $self->{dbpasswd} = unpack 'u', $self->{dbpasswd}; - my $dbh = DBI->connect( $self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd}) - or $form->dberror; + or $form->dberror(__FILE__.':'.__LINE__); my $query = qq| SELECT count(*) FROM recurring @@ -265,14 +291,14 @@ sub dbsources { my $dbh = DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) - or $form->dberror; + or $form->dberror(__FILE__.':'.__LINE__); if ($form->{dbdriver} eq 'Pg') { $query = qq|SELECT datname FROM pg_database|; $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth->execute || $form->dberror(__FILE__.':'.__LINE__.$query); while (my ($db) = $sth->fetchrow_array) { @@ -284,7 +310,7 @@ sub dbsources { my $dbh = DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) - or $form->dberror; + or $form->dberror(__FILE__.':'.__LINE__); $query = qq| SELECT tablename FROM pg_tables @@ -292,7 +318,7 @@ sub dbsources { AND tableowner = ?|; my $sth = $dbh->prepare($query); $sth->execute($form->{dbuser}) - || $form->dberror($query); + || $form->dberror(__FILE__.':'.__LINE__.$query); if ($sth->fetchrow_array) { push @dbsources, $db; @@ -330,9 +356,9 @@ sub dbcreate { $form->{dbconnect}, $form->{dbsuperuser}, $form->{dbsuperpasswd}) - or $form->dberror; + or $form->dberror(__FILE__.':'.__LINE__); my $query = qq|$dbcreate{$form->{dbdriver}}|; - $superdbh->do($query) || $form->dberror($query); + $superdbh->do($query) || $form->dberror(__FILE__.':'.__LINE__.$query); $superdbh->disconnect; } @@ -344,13 +370,13 @@ sub dbcreate { $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) - or $form->dberror; + or $form->dberror(__FILE__.':'.__LINE__); if ($form->{dbsuperuser}){ my $superdbh = DBI->connect( $form->{dbconnect}, $form->{dbsuperuser}, $form->{dbsuperpasswd}) - or $form->dberror; + or $form->dberror(__FILE__.':'.__LINE__); # JD: We need to check for plpgsql, # if it isn't there create it, if we can't error # Good chance I will have to do this twice as I get @@ -400,12 +426,12 @@ sub process_query { return unless (-f $filename); - open(FH, "$filename") or $form->error("$filename : $!\n"); + open(FH, "$filename") or $form->error(__FILE__.':'.__LINE__.": $filename : $!\n"); $ENV{PGPASSWORD} = $form->{dbpasswd}; $ENV{PGUSER} = $form->{dbuser}; $ENV{PGDATABASE} = $form->{db}; - open(PSQL, "| psql") or $form->error("psql : $! \n"); + open(PSQL, "| psql") or $form->error(__FILE__.':'.__LINE__.": psql : $! \n"); print PSQL "\\o spool/log \n"; while (<FH>){ print PSQL $_; @@ -423,9 +449,9 @@ sub dbdelete { &dbconnect_vars($form, $form->{dbdefault}); my $dbh = DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) - or $form->dberror; + or $form->dberror(__FILE__.':'.__LINE__); my $query = qq|DROP DATABASE "$form->{db}"|; - $dbh->do($query) || $form->dberror($query); + $dbh->do($query) || $form->dberror(__FILE__.':'.__LINE__.$query); $dbh->disconnect; @@ -439,10 +465,10 @@ sub dbsources_unused { my @dbexcl = (); my @dbsources = (); - $form->error("$memfile locked!") if (-f "${memfile}.LCK"); + $form->error(__FILE__.':'.__LINE__.": $memfile locked!") if (-f "${memfile}.LCK"); # open members file - open(FH, "$memfile") or $form->error("$memfile : $!"); + open(FH, "$memfile") or $form->error(__FILE__.':'.__LINE__.": $memfile : $!"); while (<FH>) { if (/^dbname=/) { @@ -480,7 +506,7 @@ sub dbneedsupdate { my $dbh = DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) - or $form->dberror; + or $form->dberror(__FILE__.':'.__LINE__); if ($form->{dbdriver} =~ /Pg/) { @@ -490,7 +516,7 @@ sub dbneedsupdate { WHERE d.datdba = u.usesysid AND u.usename = ?|; my $sth = $dbh->prepare($query); - $sth->execute($form->{dbuser}) || $form->dberror($query); + $sth->execute($form->{dbuser}) || $form->dberror(__FILE__.':'.__LINE__.$query); while (my ($db) = $sth->fetchrow_array) { @@ -501,14 +527,14 @@ sub dbneedsupdate { my $dbh = DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) - or $form->dberror; + or $form->dberror(__FILE__.':'.__LINE__); $query = qq| SELECT tablename FROM pg_tables WHERE tablename = 'defaults'|; my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $sth->execute || $form->dberror(__FILE__.':'.__LINE__.$query); if ($sth->fetchrow_array) { $query = qq| @@ -548,7 +574,7 @@ sub dbupdate { if ($form->{dbupdate}) { # read update scripts into memory - opendir SQLDIR, "sql/." or $form->error($!); + opendir SQLDIR, "sql/." or $form->error(__FILE__.':'.__LINE__.': '.$!); @upgradescripts = sort script_version grep /$form->{dbdriver}-upgrade-.*?\.sql$/, @@ -568,7 +594,7 @@ sub dbupdate { my $dbh = DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, {AutoCommit => 0}) - or $form->dberror; + or $form->dberror(__FILE__.':'.__LINE__); # check version $query = qq| @@ -657,114 +683,102 @@ sub script_version { } - -sub create_config { - my ($self, $filename) = @_; - - - @config = &config_vars; - - open(CONF, ">$filename") or $self->error("$filename : $!"); - - # create the config file - print CONF qq|# configuration file for $self->{login} - -\%myconfig = ( -|; - - foreach $key (sort @config) { - $self->{$key} =~ s/\\/\\\\/g; - $self->{$key} =~ s/'/\\'/g; - - #remaining conversion from SL - $self->{$key} =~ s/sql-ledger([^.]*)\.css/ledger-smb$1.css/g; - print CONF qq| $key => '$self->{$key}',\n|; - } - - - print CONF qq|);\n\n|; - - close CONF; - -} - - sub save_member { - my ($self) = @_; - - # format dbconnect and dboptions string - &dbconnect_vars($self, $self->{dbname}); - $self->error("${LedgerSMB::Sysconfig::memberfile} locked!") - if (-f "${LedgerSMB::Sysconfig::memberfile}.LCK"); - open(FH, ">${LedgerSMB::Sysconfig::memberfile}.LCK") - or $self->error("${LedgerSMB::Sysconfig::memberfile}.LCK : $!"); - close(FH); + my ($self) = @_; - if (! open(CONF, "+<${LedgerSMB::Sysconfig::memberfile}")) { - unlink "${LedgerSMB::Sysconfig::memberfile}.LCK"; - $self->error("${LedgerSMB::Sysconfig::memberfile} : $!"); - } + # replace \r\n with \n + for (qw(address signature)) { $self->{$_} =~ s/\r?\n/\\n/g } - @config = <CONF>; + # use central db + my $dbh = ${LedgerSMB::Sysconfig::GLOBALDBH}; - seek(CONF, 0, 0); - truncate(CONF, 0); + #check to see if the user exists already + my $userCheck = $dbh->prepare("SELECT id FROM users WHERE username = ?"); + $userCheck->execute($self->{login}); + my ($userID) = $userCheck->fetchrow_array; - while ($line = shift @config) { - last if ($line =~ /^\[$self->{login}\]/); - #remaining conversion from SL - $line =~ s/sql-ledger([^.]*)\.css/ledger-smb$1.css/g; - print CONF $line; - } + if($userID){ + #got an id, check to see if it's in the users_conf table + my $userConfCheck = $dbh->prepare("SELECT id FROM users_conf WHERE id = ?"); + $userConfCheck->execute($userID); - # remove everything up to next login or EOF - while ($line = shift @config) { - last if ($line =~ /^\[/); + if($userConfCheck->rows){ + my $userConfExists = 1; + } } - - # this one is either the next login or EOF - print CONF $line; - - while ($line = shift @config) { - print CONF $line; + else{ + my $userConfAdd = $dbh->prepare("SELECT create_user(?);"); + $userConfAdd->execute($self->{login}); + ($userID) = $userConfAdd->fetchrow_array; } - print CONF qq|[$self->{login}]\n|; - - if ($self->{packpw}) { - $self->{dbpasswd} = pack 'u', $self->{dbpasswd}; - chop $self->{dbpasswd}; - } - if ($self->{password} ne $self->{old_password}) { - $self->{password} = crypt $self->{password}, - substr($self->{login}, 0, 2) if $self->{password}; - } + if($userConfExists){ + + # for now, this is updating the table directly... ugly + my $userConfUpdate = $dbh->prepare("UPDATE users_conf + SET acs = ?, address = ?, businessnumber = ?, + company = ?, countrycode = ?, currency = ?, + dateformat = ?, dbconnect = ?, dbdriver = ?, + dbhost = ?, dbname = ?, dboptions = ?, + dbpasswd = ?, dbport = ?, dbuser = ?, + email = ?, fax = ?, menuwidth = ?, + name = ?, numberformat = ?, password = md5(?), + print = ?, printer = ?, role = ?, + sid = ?, signature = ?, stylesheet = ?, + tel = ?, templates = ?, timeout = ?, + vclimit = ? + WHERE id = ?;"); + + $userConfUpdate->execute($self->{acs}, $self->{address}, $self->{businessnumber}, + $self->{company}, $self->{countrycode}, $self->{currency}, + $self->{dateformat}, $self->{dbconnect}, $self->{dbdriver}, + $self->{dbhost}, $self->{dbname}, $self->{dboptions}, + $self->{dbpasswd}, $self->{dbport}, $self->{dbuser}, + $self->{email}, $self->{fax}, $self->{menuwidth}, + $self->{name}, $self->{numberformat}, $self->{password}, + $self->{print}, $self->{printer}, $self->{role}, + $self->{sid}, $self->{signature}, $self->{stylesheet}, + $self->{tel}, $self->{templates}, $self->{timeout}, + $self->{vclimit}, $userID); + - if ($self->{'root login'}) { - @config = qw(password); - } else { - @config = &config_vars; } - - # replace \r\n with \n - for (qw(address signature)) { $self->{$_} =~ s/\r?\n/\\n/g } - - for (sort @config) { - print CONF qq|$_=$self->{$_}\n| + else{ + + my $userConfInsert = $dbh->prepare("INSERT INTO users_conf(acs, address, businessnumber, + company, countrycode, currency, + dateformat, dbconnect, dbdriver, + dbhost, dbname, dboptions, dbpasswd, + dbport, dbuser, email, fax, menuwidth, + name, numberformat, print, printer, role, + sid, signature, stylesheet, tel, templates, + timeout, vclimit, id, password) + VALUES(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, + ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, + ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, md5(?));"); + + $userConfInsert->execute($self->{acs}, $self->{address}, $self->{businessnumber}, + $self->{company}, $self->{countrycode}, $self->{currency}, + $self->{dateformat}, $self->{dbconnect}, $self->{dbdriver}, + $self->{dbhost}, $self->{dbname}, $self->{dboptions}, + $self->{dbpasswd}, $self->{dbport}, $self->{dbuser}, + $self->{email}, $self->{fax}, $self->{menuwidth}, + $self->{name}, $self->{numberformat}, + $self->{print}, $self->{printer}, $self->{role}, + $self->{sid}, $self->{signature}, $self->{stylesheet}, + $self->{tel}, $self->{templates}, $self->{timeout}, + $self->{vclimit}, $userID, $self->{password}); + } - print CONF "\n"; - close CONF; - unlink "${LedgerSMB::Sysconfig::memberfile}.LCK"; - # create conf file - if (! $self->{'root login'}) { - - $self->create_config("${LedgerSMB::Sysconfig::userspath}/$self->{login}.conf"); + if (! $self->{'admin'}) { $self->{dbpasswd} =~ s/\\'/'/g; $self->{dbpasswd} =~ s/\\\\/\\/g; - $self->{dbpasswd} = unpack 'u', $self->{dbpasswd}; + + # format dbconnect and dboptions string + &dbconnect_vars($self, $self->{dbname}); # check if login is in database my $dbh = DBI->connect( @@ -813,7 +827,6 @@ sub save_member { $dbh->disconnect; } - } @@ -823,13 +836,13 @@ sub delete_login { my $dbh = DBI->connect( $form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, {AutoCommit => 0}) - or $form->dberror; + or $form->dberror(__FILE__.':'.__LINE__); my $login = $form->{login}; $login =~ s/@.*//; my $query = qq|SELECT id FROM employee WHERE login = ?|; my $sth = $dbh->prepare($query); - $sth->execute($login) || $form->dberror($query); + $sth->execute($login) || $form->dberror(__FILE__.':'.__LINE__.': '.$query); my ($id) = $sth->fetchrow_array; $sth->finish; |