<%@LANGUAGE=PerlScript%>
<%
# > CORRECT EMACS DISPLAY
# --- general error treatment functions for IFL
# --- By NHaggett, UniRom, March 2004
my $errnumlimit = 11;
my @Errors = ();
my $numerrs = 0;
sub AddErr {
my $err = shift();
if ($numerrs == $errnumlimit) {
push(@Errors,"Too many errors.");
}elsif ($numerrs < $errnumlimit) {
push(@Errors,$err);
}
$numerrs++;
}
sub CheckConnErr {
my $ConnLocal = shift();
foreach my $errHash (Win32::OLE::in($ConnLocal->Errors)) {
if ((${$errHash}{"Number"} != 0)&&(${$errHash}{"Description"} !~ m/Changed database context to/)) {
&AddErr("Error with last call to dbConnection: " . ${$errHash}{"Description"});
&AddErr("01 Server cannot verify User permissions at present. Please try later.");
}
}
}
sub ErrReportJS{
my $retStr = qq[\n\n];
}
sub ErrReportHTML{
my $retStr = qq[\n
\n];
my $count = 1;
$retStr .= qq[Sorry, the page could not be processed properly due to the following error(s)\n];
foreach my $err (@Errors) {
$err =~ s/'/\\'/g;
$retStr .= "
" . $count . "] " . $err . "\n";
$count++;
}
$retStr .= qq[
\n];
return $retStr;
}
%>
<%
# > CORRECT EMACS DISPLAY
# --- general login functions for IFL
# --- By NHaggett, UniRom, March 2004
# requires global definition of $perl56, $today, $Conn (some subs)
# most of these require a Connection object and the error treatment.
# ---N o t e s---
# $isOK = 0; # the login status (new, Nick Holmes Oct. 2002). Codes:
# # 0: not logged in - Resources access
# # 1: logged in current user - full access
# # 2: logged in expired user - Resources access
# # 3: logged in cancelled user - Resources access
# $login_result = 5; # result of login query. Used to set login state (above) in Session variable. VALUES:
# # 0: Failed; --> isOK = 0
# # 1: No such login; --> isOK = 0
# # 2: Expired; --> isOK = 2
# # 3: Suspended; --> isOK = 3
# # 4: OK; --> isOK = 1
# # 5: (default); --> isOK = 0
# # 6: will expire in next 7 days --> isOK = 1
# # 7: - mothballed
# # 8: (HOLD) payment pending; --> isOK = 0
# --------------------------------------------------------------------------------------------------------
#if ($perl56 == 1) {
# use Win32::OLE::Variant;
# use Win32::OLE::NLS qw(:LOCALE :DATE);
#}
sub GetUserIDByPasswd {
# pre-login query
# RTN: userid (number)
my ($Connlocal,$email,$passwd) = @_;
my $sqlStr = "";
my $retValue = 0;
if ($email eq "") {
&AddErr("Cannot login: please supply email.");
}
if ($passwd eq "") {
&AddErr("Cannot login: please supply password.");
}
if ($numerrs == 0) {
$sqlStr .= "SELECT ";
$sqlStr .= "user_id AS ID ";
$sqlStr .= "FROM USERS WHERE email = '" . $email . "' AND password = '" . $passwd . "';";
my $rs = $Connlocal->Execute($sqlStr);
&CheckConnErr($Connlocal);
if ($numerrs == 0){
if (!$rs->EOF) {
$retValue = $rs->Fields("ID")->value;
}else {
$retValue = 0;
}
$rs->Close();
}
}
# $Response->write(qq[]);
return $retValue;
}
sub GetUserIDByIP {
# pre-login query
# RTN: userid (number)
my ($Connlocal,$remoteIP) = @_;
my $retValue = 0;
my $ABC;
my $D;
my @subids = (); # all subid s found ( should be 1!)
if ($remoteIP =~ m/^((?:\d+\.){3})(\d+)$/) {
$ABC = $1;
$D = $2;
}else {
&AddErr("Cannot login: failed to get something like a remote IP address.");
}
if ($numerrs == 0) {
# IP address mask: A.B.C.D-A.B.C.E
# First get all entries where ip field like
# A.B.C(REMOTE_HOST)
$remoteIP =~ m/^((?:\d+\.){3})(\d+)$/;
my $userSQL = "SELECT ";
$userSQL .= "USERS.user_id AS ID, ";
$userSQL .= "USERS.ip_address AS ipaddress ";
$userSQL .= "FROM USERS ";
$userSQL .= "WHERE USERS.ip_address LIKE '%" . $ABC . "%';";
my $Uset = $Connlocal->Execute($userSQL);
&CheckConnErr($Connlocal);
if ($numerrs == 0){
if (!$Uset->EOF) {
# if there are no matches we just ignore and do the non-logged in version.
while (!$Uset->EOF) {
# -- is it actually the one we want?
my $uid = $Uset->Fields("ID")->value;
my $uiprange = $Uset->Fields("IPADDRESS")->value;
if ($uiprange =~ /^((?:\d+\.){3})(\d+)-\1(\d+)$/) {
my $ABC_stored = $1;
my $startip = $2;
my $endip = $3;
if ($ABC_stored eq $ABC) {
push(@subids,$uid) if ($startip <= $D and $D <= $endip);
}
}
} continue {
$Uset->MoveNext();
}
}
$Uset->Close();
}
undef $Uset;
}
if ($numerrs == 0) {
if (scalar(@subids) == 1) {
$retValue = $subids[0];
} elsif (scalar(@subids) > 1) {
# !!
&AddErr("More than one account fits the ip address !!");
}
}
return $retValue;
}
sub GetUserDetailsByID {
# login details
# RTN: date of expiry (str), company name, email, realname, status (num) , LF subid for this user (num), payment pending, login result code
my ($Connlocal,$userID,$today,$productGroup) = @_;
my @retList = ();
my $retDate;
my $retCompany;
my $retEmailname;
my $retRealname;
my $retStatus;
my $retSubid;
my $retLoginresult;
my $sqlStr = "";
# ------------------------------------
# Only for Perl 5.6 machines.
# ---SERVER DEPENDENT---
my $perl56 = 1;
if (($userID eq "")||($userID == 0)) {
&AddErr("Cannot login: no user ID passed.");
}
# NHa 20050505
if ($productGroup eq "") {
$productGroup = "LF"; # this makes the updated function compatible with old Lawfinder logins
}
# $Response->write(qq[]);
if ($numerrs == 0) {
$sqlStr .= "SELECT ";
$sqlStr .= "CUSTOMERS.company as company, ";
$sqlStr .= "USERS.email as username, ";
$sqlStr .= "USERS.realname as realname, ";
$sqlStr .= "SUBS.sub_id as subid, ";
$sqlStr .= "SUBS.enabled as enabled, ";
$sqlStr .= "SUBS.expiry_date as expiry_date ";
$sqlStr .= "FROM PRODUCTS INNER JOIN (SUBS INNER JOIN (USERS INNER JOIN CUSTOMERS ON CUSTOMERS.customer_id = USERS.customer_id) ON SUBS.user_id = USERS.user_id) ON PRODUCTS.product_code = SUBS.product_code ";
$sqlStr .= "WHERE USERS.user_id = " . $userID . ";";
# $sqlStr .= "WHERE USERS.user_id = 12345678;";
my $rs = $Connlocal->Execute($sqlStr);
&CheckConnErr($Connlocal);
if ($numerrs == 0){
if (!$rs->EOF) {
# $Response->write(qq[]);
my $sql_expiry_date = $rs->Fields("expiry_date")->value;
# $Response->write(qq[]);
if ($perl56 == 1) {
my $edatevar = Variant(VT_DATE, "$sql_expiry_date");
if ($edatevar ne "") {
$retDate = $edatevar->Date("dd/MM/yyyy");
} else {
$retDate = "";
}
} else {
$retDate = $rs->Fields("expiry_date")->value;
}
# $Response->write(qq[]);
$retCompany = $rs->Fields("company")->value;
$retEmailname = $rs->Fields("username")->value;
$retRealname = $rs->Fields("realname")->value;
$retStatus = $rs->Fields("enabled")->value;
$retSubid = $rs->Fields("subid")->value;
} else {
&AddErr("No subscription for this service was found for your account. You may need to logout and login again with a different email.");
}
$rs->Close();
}
if ($numerrs == 0) {
# get 'pending payment' field
$sqlStr = "SELECT ORDERS.payment ";
$sqlStr .= "FROM ORDERS INNER JOIN SUBS ON SUBS.order_id = ORDERS.order_id ";
$sqlStr .= "WHERE SUBS.sub_id = " . $retSubid . ";";
my $Results = $Connlocal->Execute($sqlStr);
&CheckConnErr($Connlocal);
if ($numerrs == 0) {
if (!$Results->EOF) {
$retPayment = $Results->Fields("payment")->value;
}
$Results->Close();
}
}
if ($numerrs == 0) {
####$Response->write(qq[]);
if ($retStatus == 1) {
$retLoginresult = &ValDate($retDate,$userID,$today);
} elsif ($retStatus == 2) { # hold
$retLoginresult = 8;
} else {
$retLoginresult = 3;
}
}
}
@retList = ($retDate,$retCompany,$retEmailname,$retRealname,$retStatus,$retSubid,$retPayment,$retLoginresult);
return \@retList;
}
sub ValDate {
# check that a user's dates are valid and set the sublink string
# RTN: ifl login result (number)
my ($expiryDate,$userID,$todayLocal) = @_;
my $err;
if (($userID eq "")||($userID == 0)) {
&AddErr("Date validation requires a userid.");
}
if ($numerrs == 0) {
# - - - - - - - - - - - - - - - - - - - - - - -
# New 2001 11 07:
# the sublink string is in memory if the user is to expire in < 30 days.
# To show link, insert this code on ASP pages:
# if ($Session->{"sublink"} ne "") {
# $Response->write("
Subscribe now?
" . $Session->{"sublink"});
# }
# - - - - - - - - - - - - - - - - - - - - - - -
if ($expiryDate ne "") {
my $date1 = &ParseDate($todayLocal);
my $date2 = &ParseDate($expiryDate);
my $dt_interval = &DateCalc($date1,$date2,\$err,0);
my $interval_days = &Delta_Format($dt_interval,0,("%dh"));
#$Response->write(qq[]);
if ($date2 lt $date1) {
return 2;
} elsif ($interval_days <= 7) {
$Session->{"sublink"} = qq[Your Lawfinder subscriber access expires on ] . $expiryDate . qq[. For continued access, please see
Subscription options.];
return 6;
} else {
if ($interval_days <= 30) {
$Session->{"sublink"} = qq[Your Lawfinder subscriber access expires on ] . $expiryDate . qq[. For continued access, please see
Subscription options.];
}
return 4;
}
} else {
return 4; # no expiry date (backward compatibility to old accounts)
}
}
}
sub SetLStateMssg {
# set the isOK variable using login information gathered above,
# and return a message string as well. Calls GetPending()
# RTN: 1 or 0 (isOK), login message
my ($loginresult,$pendingField) = @_;
my $loginMessage = "";
my $securitystatus = 0;
my @retList = ();
#$Response->write(qq[]);
if ($loginresult == 0) {
$securitystatus = 0;
}elsif ($loginresult == 1) {
#
$loginMessage = qq[
| \n User not recognised
Email: ] . $gotcha . qq[
Password: ] . $psswd . qq[ \n |
\n];
$loginMessage .= qq[
| \n Sorry, your account cannot be found.
\n];
$loginMessage .= qq[ Please try again or Register.\n \n |
\n];
$securitystatus = 0;
}elsif ($loginresult == 2) {
#
$loginMessage = qq[
| \n \nYour subscriber access has expired.
\n];
$loginMessage .= qq[ For continued access, please refer to the Subscription options or contact infolaw Subscriptions at \n];
$loginMessage .= qq[ subscribe\@infolaw.co.uk, telephone 020 8878 3033.\n];
$loginMessage .= qq[ |
| \n];
$loginMessage .= qq[ \n];
$loginMessage .= qq[ |
\n];
$securitystatus = 2;
}elsif ($loginresult == 3) {
#
$loginMessage = qq[
| \n Your Lawfinder subscriber access has been suspended or cancelled.
\n];
$loginMessage .= qq[ Please contact infolaw Subscriptions at subscribe\@infolaw.co.uk, telephone 020 8878 3033. \n];
$loginMessage .= qq[ |
\n];
$loginMessage .= qq[
|
\n];
$securitystatus = 3;
}elsif ($loginresult == 4) {
#
$loginMessage = qq[
| \n Please wait while your browser is re-directed. If nothing happens, please click on the link below:
\n];
$loginMessage .= qq[ Lawfinder main browse page. \n |
\n];
$securitystatus = 1;
}elsif ($loginresult == 5) {
$loginMessage .= qq[
| \n Error, no query executed, or unexpected error. \n];
$loginMessage .= qq[ |
\n];
$securitystatus = 0;
}elsif ($loginresult == 6) {
#
$loginMessage = qq[
| \n Your Lawfinder subscriber access will expire on ] . $user_expiry . qq[.
\n];
$loginMessage .= qq[ For continued access after this date, please complete the Subscription Form. \n];
$loginMessage .= qq[ \n];
$loginMessage .= qq[ |
\n];
$securitystatus = 1;
}elsif ($loginresult == 8) {
#
$loginMessage = qq[
| \n];
if ($pendingField =~ m/pending/i) {
$loginMessage .= qq[ Payment pending
Your Lawfinder subscription will (re)start on receipt of payment. \n];
$loginMessage .= qq[
Enquiries email subscribe\@infolaw.co.uk \n];
}else {
$loginMessage .= qq[ Your account is on hold.
\n];
$loginMessage .= qq[ Enquiries email subscribe\@infolaw.co.uk \n];
}
$loginMessage .= qq[ |
\n];
$loginMessage .= qq[
| \n];
$loginMessage .= qq[ \n];
$loginMessage .= qq[ |
\n];
$securitystatus = 0;
}else {
$securitystatus = 0;
}
@retList = ($securitystatus,$loginMessage);
return \@retList;
}
sub LoginLog {
# RTN: nothing returned
my ($ConnLocal,$userID,$productgroup) = @_;
my @subids = ();
my $sqlStr = "";
# find out the subid(s) for this userid/product type combination
# - I suppose there should only be one really ...
$sqlStr .= "SELECT subs.sub_id AS theid ";
$sqlStr .= "FROM subs INNER JOIN products on products.product_code = subs.product_code ";
$sqlStr .= "WHERE products.product_group = '" . $productgroup . "' ";
$sqlStr .= "AND subs.user_id = " . $userID . ";";
my $subSet = $ConnLocal->Execute($sqlStr);
&CheckConnErr($ConnLocal);
if ($subSet ne "") {
if (!$subSet->EOF) {
while (!$subSet->EOF) {
push(@subids,$subSet->Fields("theid")->value);
}continue {
$subSet->MoveNext;
}
}
$subSet->Close();
$sqlStr = "";
}
if (scalar(@subids) > 1) {
# ah, more than one match, but we aren't complaining
}elsif (scalar(@subids) == 0) {
# ah, no matches!- but we aren't complaining
}else {
$sqlStr = "UPDATE subs ";
$sqlStr .= "SET logins = (logins + 1) ";
$sqlStr .= "WHERE sub_id = " . $subids[0] . ";";
$ConnLocal->Execute($sqlStr);
#$Response->write(qq[]);
&CheckConnErr($ConnLocal);
}
}
sub FeedAccess {
my ($ConnLocal,$wfHash) = @_;
my $retValue = 0;
my $retUID = 0;
my $sqlStr = "";
my $RSet;
my @retList = ();
$sqlStr = "SELECT sub_id,user_id,product_code ";
$sqlStr .= "FROM SUBS ";
$sqlStr .= "WHERE access_hash = '" . $wfHash . "'";
$RSet = $ConnLocal->Execute($sqlStr);
&CheckConnErr($ConnLocal);
if ($numerrs == 0) {
if ($RSet->EOF) {
$retValue = 0;
}else {
if ($RSet->Fields("product_code")->value eq "WEB-WF") {
$retUID = $RSet->Fields("user_id")->value;
$retValue = 1;
}else {
$retValue = 0;
}
}
$RSet->Close();
}else {
&AddErr("Sorry, a server database error prevented your feed access from being verified. Please try again later.");
}
@retList = ($retValue,$retUID);
return \@retList;
}
sub CheckProductGroup {
# RTN: 1 or 0.
my ($Connlocal,$userID,$ProductGroup) = @_;
my $retVal = 0;
my $sqlStr = "";
if (($userID eq "")||($userID == 0)) {
&AddErr("Cannot check product group: no user ID passed.");
}
if ($ProductGroup eq "") {
&AddErr("Cannot check product group: no value given!");
}
if ($numerrs == 0) {
$sqlStr .= "SELECT ";
$sqlStr .= "SUBS.sub_id as subid, ";
$sqlStr .= "SUBS.enabled as enabled ";
$sqlStr .= "FROM PRODUCTS INNER JOIN (SUBS INNER JOIN USERS ON SUBS.user_id = USERS.user_id) ON PRODUCTS.product_code = SUBS.product_code ";
$sqlStr .= "WHERE PRODUCTS.product_group = '" . $ProductGroup . "' ";
$sqlStr .= "AND USERS.user_id = " . $userID . ";";
my $rs = $Connlocal->Execute($sqlStr);
&CheckConnErr($Connlocal);
if ($numerrs == 0){
if (!$rs->EOF) {
# at least one subscription exists in this product group.
my $SSSS = $rs->Fields("enabled")->value;
$retVal = 1;
} else {
$retVal = 0;
}
$rs->Close();
}else {
#AddErr($sqlStr);
&AddErr("Sorry the product group query could not be completed.");
}
}
return $retVal;
}
sub CheckProductGroupFull {
# RTN: 1 or 0.
my ($Connlocal,$userID,$ProductGroup,$today) = @_;
my $retVal = 0;
my $sqlStr = "";
if (($userID eq "")||($userID == 0)) {
&AddErr("Cannot check product group: no user ID passed.");
}
if ($ProductGroup eq "") {
&AddErr("Cannot check product group: no value given!");
}
if ($numerrs == 0) {
$sqlStr .= "SELECT ";
$sqlStr .= "SUBS.sub_id as subid, ";
$sqlStr .= "SUBS.enabled as enabled ";
$sqlStr .= "FROM PRODUCTS INNER JOIN (SUBS INNER JOIN USERS ON SUBS.user_id = USERS.user_id) ON PRODUCTS.product_code = SUBS.product_code ";
if ($ProductGroup eq "INL") {
$sqlStr .= "WHERE (PRODUCTS.product_group = 'INL' OR PRODUCTS.product_group LIKE 'LW%') ";
} else {
$sqlStr .= "WHERE PRODUCTS.product_group = '" . $ProductGroup . "' ";
}
$sqlStr .= "AND USERS.user_id = " . $userID . " ";
$sqlStr .= "AND SUBS.enabled = 1 ";
$sqlStr .= "AND (SUBS.expiry_date >= #" . $today . "# ";
$sqlStr .= "OR SUBS.expiry_date IS NULL);";
my $rs = $Connlocal->Execute($sqlStr);
&CheckConnErr($Connlocal);
if ($numerrs == 0){
if (!$rs->EOF) {
# at least one subscription exists in this product group.
my $SSSS = $rs->Fields("enabled")->value;
$retVal = 1;
} else {
$retVal = 0;
}
$rs->Close();
}else {
#AddErr($sqlStr);
&AddErr("Sorry the product group query could not be completed.");
}
}
# $Response->write(qq[]);
return $retVal;
}
sub CheckSubByProductID {
my ($Connlocal,$uID,$SPid,$today) = @_;
my $retSubID = 0;
my $sqlStr = "";
return 0 if (($uID == 0)||($SPid eq ""));
if ($numerrs == 0) {
$sqlStr .= "SELECT ";
$sqlStr .= "SUBS.sub_id as subid ";
$sqlStr .= "FROM PRODUCTS INNER JOIN (SUBS INNER JOIN USERS ON SUBS.user_id = USERS.user_id) ON PRODUCTS.product_code = SUBS.product_code ";
$sqlStr .= "WHERE PRODUCTS.product_code = '" . $SPid . "' ";
$sqlStr .= "AND USERS.user_id = " . $uID . " ";
$sqlStr .= "AND SUBS.enabled = 1;";
my $rs = $Connlocal->Execute($sqlStr);
&CheckConnErr($Connlocal);
if ($numerrs == 0) {
if (!$rs->EOF) {
# at least one subscription exists in this product group.
$retSubID = $rs->Fields("subid")->value;
}
$rs->Close();
} else {
#AddErr($sqlStr);
&AddErr("Sorry the subscription query could not be completed for the requested product.");
}
}
return $retSubID;
}
sub return_user_status_html {
my $emailname = $Session->{"gotcha"};
my $user_identifier = $Session->{"gotid"};
my $response;
if ($user_identifier > 0) {
$response = qq[
] . $emailname . qq[ signed in | Sign out | Terms | Privacy];
} else {
$response = qq[
Guest | Terms of use | Privacy];
}
return $response;
}
%>
<%
$Response->Write(&return_user_status_html);
%>
RSS webfeed errors
Reasons for errors in generating Lawfinder webfeeds are given below.
No Lawfinder type selected
The feed URL must include the Lawfinder type and category required.
The search returned no results
The Lawfinder type and category specified are not valid.
Other processing error
Please note the error and try again later. If the error continues, please contact support@infolaw.co.uk.
