I recently used pp to compile a perl CGI. It worked fine on the command line (with some environment variables set.) However, when used from the website, I get the message:
The specified CGI application misbehaved by not returning a complete set of HTTP headers. The headers it did return are "Usage: D:\cslink\www\cgi\rds\cgilkup.exe -Alib.par -Idir -Mmodule src.par program.pl D:\cslink\www\cgi\rds\cgilkup.exe -b -Ooutfile src.par ".
Code is here (requires a database if you actually want to test it)
#!/users/rds/perl/bin/perl
#*********************************************************************
+*******
#*
+ *
#* PROGRAM NAME: CgiLkup.pl
#* AUTHOR: Nils Mork
+ *
#*
+ *
#*********************************************************************
+*******
#* MODIFICATION HISTORY:
+ *
#*
+ *
#* DATE PROGRAMER COMMENT
+ *
#* 04-07-03 nmork Initial Creation
+ *
#*********************************************************************
+*******
push @INC,"c:\\cslink\\ctl";
push @INC,"d:\\cslink\\ctl";
push @INC,"e:\\cslink\\ctl";
push @INC,"f:\\cslink\\ctl";
use CGI qw/:standard/;
use DBI;
$cgi = new CGI;
print $cgi->header(-type=>'text/html');
require "CSLINK2_pl";
$v_user_id = ($ENV{'REMOTE_USER'} =~ /\w/) ? lc($ENV{'REMOTE_USER'})
: ($ENV{'HTTP_REMOTE_USER'} =~ /\w/) ? lc($ENV{'HTTP_REMOTE
+_USER'})
: $cgi->cookie('cslinkacct');
$v_program_id = ($cgi->param('program_id') =~ /\w/)
? $cgi->param('program_id')
: cgi_param('program_id');
$v_position = ($cgi->param('position') =~ /\w/)
? $cgi->param('position')
: cgi_param('position');
$v_pvalue = ($cgi->param('pvalue') =~ /\w/)
? $cgi->param('pvalue')
: cgi_param('pvalue');
$v_pname = ($cgi->param('pname') =~ /\w/)
? $cgi->param('pname')
: cgi_param('pname');
$v_filter = ($cgi->param('filter') =~ /\w/)
? $cgi->param('filter')
: cgi_param('filter');
$v_paction = ($cgi->param('paction') =~ /\w/)
? $cgi->param('paction')
: cgi_param('paction');
$v_grep = $v_filter;
$v_fcnt = 0;
@print_dir = ();
# Escape special characters in $v_grep
map { $v_grep =~ s/$_/$_/g }
('\\\\','\\(','\\)','\\[','\\]','\\/','\\&','\\^','\\$','\\.','\\*
+');
# Convert SQL wildcards, blank spaces in $v_grep
$v_grep =~ s/[% ]/\.\*/g;
unless ($v_user_id =~ /\w/) {
print "<H1><I><B><FONT COLOR=#CC0000>NOT AUTHORIZED</FONT></B></I></
+H1>\n";
close(STDOUT); exit(1);
}
#############################################################
#Global declarations
%AllValues =
("ALL VALUES" => 1,
"ALL_VALUES" => 1,
"ALL" => 1,
"All Values" => 1,
" " => 1,
"" => 1,
"#" => 1,
"%" => 1);
$CR_STR = chr(13);
$LF_STR = chr(10);
#############################################################
# Check if we have the minimum to continue
if ($v_program_id eq "" || $v_program_id eq " "
|| $v_position eq "" || $v_position eq "") {
print "\$v_user_id=$v_user_id \$v_program_id=\"$v_program_id\" \$v_po
+sition=\"$v_position\"\n";
close(STDOUT); exit(0);
}
#############################################################
# Get general program information
$lku_multi = "N";
if ($v_pname eq "TO-DBMS") {
$lku_prompt = "Dist Users";
$lku_multi = "Y";
$v_program_id = $v_pname;
} elsif ($v_pname eq "TO-EMAIL") {
$lku_prompt = "Dist Mails";
$lku_multi = "Y";
$v_program_id = $v_pname;
} else {
$rsRP = valRun_parameter($dbh,$v_user_id,$v_program_id,$v_position);
unless($rsRP) { close(STDOUT); exit(0); }
$lku_lkupid = $rsRP->[0]->{lookup_id};
$lku_agntid = $rsRP->[0]->{agent_id};
$lku_imskid = $rsRP->[0]->{input_mask_id};
$lku_multi = $rsRP->[0]->{allow_multiple};
$lku_value = $rsRP->[0]->{value};
$lku_prompt = $rsRP->[0]->{prompt};
$lku_filter = $rsRP->[0]->{has_filter};
} $lku_multis = ($lku_multi eq "Y") ? " multiple":"";
$lku_type = "STD";
#############################################################
# Print pop up window
if ($v_action) {
if($v_program_id eq "TO-DBMS") {
$rsLKU = getDistrib_users($dbh,"LOCAL",$v_user_id,$v_filter);
} elsif ($v_program_id eq "TO-EMAIL") {
$rsLKU = getDistrib_mails($dbh,"LOCAL",$v_filter);
} elsif($lku_lkupid) {
$rsLKU = getLookups($dbh,$lku_lkupid,$lku_imskid,$v_filter);
} elsif($lku_agntid) {
$rsLKU = getAgentData($dbh,$lku_agntid,$lku_imskid,$v_filter,$v_pv
+alue);
$lku_type = "FIL" if ($rsLKU->[0]->{type} =~ /(FIL|DIR)/);
}
}
if ($lku_type eq "FIL") {
print_fil_lookup();
} else {
print_std_lookup();
}
close(STDOUT); exit (0);
#####################################
sub print_std_lookup {
#####################################
$btn_style = "width: 98px;";
$mono_stylen="font-family: Monospace, Lucida Console, Courier, Courier
+ New, Monaco, Consolas; "
. "font-style: normal; font-variant: normal; font-weight: b
+old; "
. "font-size: 12px; line-height: normal; font-stretch: norm
+al; "
. "font-size-adjust: none; color: rgb(0,0,153);";
$fnt_stylen= "font-family: Verdana,Geneva,Arial,Helvetica,sans-serif;
+"
. "font-style: normal; font-variant: normal; font-weight: n
+ormal; "
. "font-size: 12px; line-height: normal; font-stretch: norm
+al; "
. "font-size-adjust: none; color: rgb(0,0,153);";
$inp_style = $fnt_stylen
. " border: solid #99f; border-width: 1px;";
$mono_style = $mono_stylen
. " border: solid #99f; border-width: 1px;";
print <<"END-HTML";
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"><html><
+head>
<title>$lku_prompt</title>
<meta http-equiv="content-type" content="text/html; charset=ISO-8859-1
+">
</head>
<script language="Javascript" src="/js/FormSupport.js"></script>
<script language="Javascript">
var lku_init = false;
var lku_doc = null;
var lku_form = null;
var lku_fld = null;
var lku_dlm = "+";
function lkup_init() {
if (window.resizable) window.resizable=false;
if (window.opener) {
if (window.opener != document.window) {
if (window.opener.document) {
lku_doc = window.opener.document;
if (lku_doc.input_form) {
if (lku_doc.input_form.elements) {
lku_form = lku_doc.input_form;
if (lku_form["$v_pname"]) {
if (lku_form["$v_pname"].type) {
if (lku_form["$v_pname"].type == "text") {
lku_dlm = ",";
}
lku_fld = lku_form["$v_pname"];
lku_init = true;
} else if ("TO-EMAIL" == "$v_pname" && lku_form["TO-EMAIL"][1]) {
lku_fld = lku_form["TO-EMAIL"][1];
lku_init = true;
} } } } } } }
}
function lku_search() {
// Call agent or Lookup search
document.input_form.paction.value="1";
document.input_form.submit();
}
function lku_done() {
// Copy values to calling window object
lku_set();
window.close();
}
function lku_set() {
// Copy values to calling window object
if (lku_init) {
var sel_lookups = document.input_form.selLookups.options;
var fldvalue = getFieldValue(lku_fld,lku_dlm);
var fldtext = getFieldText(lku_fld,lku_dlm);
var str = lku_dlm+fldvalue+lku_dlm;
for (var i = 0; i < sel_lookups.length; i++) {
if (str.indexOf(lku_dlm+sel_lookups[i].value+lku_dlm) == -1
&& sel_lookups[i].selected) {
if (fldvalue != "" && fldvalue != " " && "$lku_multi" == "Y")
+{
fldvalue += lku_dlm + sel_lookups[i].value;
fldtext += lku_dlm + sel_lookups[i].text;
} else {
fldvalue = sel_lookups[i].value;
fldtext = sel_lookups[i].text;
} }
} setFieldValue(lku_fld,fldvalue,fldtext); }
}
</script>
<body bgcolor="#FFFFFF" style="margin: 0;" onload="lkup_init()">
<form name="input_form" method="get" action="/scripts/rds/cgilkup.exe?
+">
<input name="program_id" id="program_id" type="hidden" value="$v_progr
+am_id">
<input name="position" id="position" type="hidden" value="$v_position"
+>
<input name="pname" id="pname" type="hidden" value="$v_pname">
<input name="pvalue" id="pvalue" type="hidden" value="$v_pvalue">
<input name="paction" id="paction" type="hidden" value="1">
<table cellpadding="7" cellspacing="0" border="1" style="width: 400p
+x; height: 250px; background-color: #FFFFFF;">
<tbody>
<tr>
<td valign="top" style="height: 42px; width: 400px;">
<table border="0" cellpadding="0" cellspacing="0" width="100%
+">
<tr><td>
<font style="$fnt_stylen">Filter $lku_prompt by:</font><br>
<input name="filter" id="filter" type="text" size="40" maxlen
+gth="40" value="$v_filter" style="$inp_style">
</td><td>
<button id="search_btn" value="Search" onclick="lku_search()"
+ style="$btn_style"><img src="/image/csl_search.gif"></button>
<br style="height: 1px;">
<button type="button" id="set_btn" value="Set" onclick="lku_s
+et()" style="$btn_style"><img src="/image/csl_select.gif"></button>
<br style="height: 1px;">
<button type="button" id="finish_btn" value="Finish" onclick=
+"lku_done()" style="$btn_style"><img src="/image/csl_done.gif"></butt
+on>
</td></tr>
</table>
</td>
</tr>
<tr>
<td valign="top"><font size="-1">
<!-- select name="selLookups" id="selLookups" width="376" sty
+le="width: 376px; $inp_style" size="10"$lku_multis -->
<select name="selLookups" id="selLookups" width="376" style="
+width: 376px; $mono_style" size="10"$lku_multis>
END-HTML
if (@$rsLKU > 0) {
foreach $opt (@$rsLKU) {
if ($lku_filter =~ /Y/) {
print "<option value=\"$opt->{value}\">$opt->{display}\n";
} else {
print "<option value=\"$opt->{value}\">$opt->{display}\n" if ($
+opt->{display} =~ /$v_grep/i);
}
}
} elsif ($v_action) {
print "<option value=\"\">",
"(no results)",
" &nbs
+p;",
" &nbs
+p;",
" &nbs
+p;",
" &nbs
+p;",
"</option>\n";
} else {
print "<option value=\"\">",
" &nbs
+p;",
" &nbs
+p;",
" &nbs
+p;",
" &nbs
+p;",
" &nbs
+p;",
"</option>\n";
}
print <<"END-HTML";
</select>
</td>
</tr>
</tbody>
</table>
</form>
</body></html>
END-HTML
}
#####################################
sub print_fil_lookup {
#####################################
$treename = "CSL_FTree";
#$lku_prompt = "File Name";
$btn_style = "width: 98px;";
$fnt_stylen= "font-family: Verdana,Geneva,Arial,Helvetica,sans-serif;
+"
. "font-style: normal; font-variant: normal; font-weight: n
+ormal; "
. "font-size: 12px; line-height: normal; font-stretch: norm
+al; "
. "font-size-adjust: none; color: rgb(0,0,153);";
$inp_style = $fnt_stylen
. " border: solid #99f; border-width: 1px;";
print <<"END-HTML";
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"><html><
+head>
<style type="text/css">
body {
font-family: verdana, helvetica, arial, sans-serif;
}
#menuList {
margin: 0px;
padding: 10px 0px 10px 15px;
}
li.foldertop {
background: url(/image/folder.gif) no-repeat 0em 0.3em;
font-size: 14px;
line-height: 1.5em;
list-style: none outside;
}
.folder {
display: none;
margin-left: 15px;
padding: 0px;
}
.folder li {
background: url(/image/page.gif) no-repeat 0em 0.3em;
list-style: none outside;
line-height: 1.5em;
}
a.actuator {
background-color: transparent;
color: #000;
font-size: 14px;
padding-left: 20px;
text-decoration: none;
}
a.actuator:hover {
text-decoration: underline;
}
.folder li a {
background-color: transparent;
color: #000;
font-size: 14px;
padding-left: 20px;
text-decoration: none;
}
.folder li a:hover {
text-decoration: underline;
}
span.key {
text-decoration: underline;
}
</style>
<title>$lku_prompt</title>
<meta http-equiv="content-type" content="text/html; charset=ISO-8859-1
+">
</head>
<script language="Javascript" src="/js/FormSupport.js"></script>
<script language="Javascript" src="/js/FormSupport.js"></script>
<script type="text/javascript" language="Javascript">
var lku_init = false;
var lku_doc = null;
var lku_form = null;
var lku_fld = null;
var lku_dlm = "+";
var lku_value = "";
function lkup_init() {
if (window.resizable) window.resizable=false;
if (window.opener) {
if (window.opener != document.window) {
if (window.opener.document) {
lku_doc = window.opener.document;
if (lku_doc.input_form) {
if (lku_doc.input_form.elements) {
lku_form = lku_doc.input_form;
if (lku_form["$v_pname"]) {
if (lku_form["$v_pname"].type) {
if (lku_form["$v_pname"].type == "text") {
lku_dlm = ",";
}
lku_fld = lku_form["$v_pname"];
lku_init = true;
} else if ("TO-EMAIL" == "$v_pname" && lku_form["TO-EMAIL"][1]) {
lku_fld = lku_form["TO-EMAIL"][1];
lku_init = true;
} } } } } } }
}
function lku_search() {
// Call agent or Lookup search
document.input_form.paction.value="1";
document.input_form.submit();
}
function lku_done() {
// Copy values to calling window object
lku_set();
window.close();
}
function lku_set(lv) {
// Copy values to calling window object
if (lku_set.arguments.length == 1) lku_value = lv;
if (lku_init) {
var fldvalue = getFieldValue(lku_fld,lku_dlm);
var fldtext = getFieldText(lku_fld,lku_dlm);
var str = lku_dlm+fldvalue+lku_dlm;
if (str.indexOf(lku_dlm+lku_value+lku_dlm) == -1 && lku_value !=
+"") {
if (fldvalue != "" && fldvalue != " " && "$lku_multi" == "Y")
+{
fldvalue += lku_dlm + lku_value;
fldtext += lku_dlm + lku_value;
} else {
fldvalue = lku_value;
fldtext = lku_value;
} }
setFieldValue(lku_fld,fldvalue,fldtext); }
}
if (!document.getElementById)
document.getElementById = function() { return null; }
function init_FTree(menuId, actuatorId) {
var menu = document.getElementById(menuId);
var actuator = document.getElementById(actuatorId);
if (menu == null || actuator == null) return;
actuator.parentNode.style.backgroundImage = "url(/image/folder.gif
+)";
actuator.onclick = function() {
var display = menu.style.display;
this.parentNode.style.backgroundImage =
(display == "block") ? "url(/image/folder.gif)" : "url(/im
+age/folderopen.gif)";
menu.style.display = (display == "block") ? "none" : "block";
return false;
}
}
window.onload = function() {
lkup_init();
document.getElementById("menuList").style.display = "block";
END-HTML
unless ($v_grep =~ /\w/) {
print_dir_init($rsLKU,0);
}
print <<"END-HTML";
}
</script>
<body bgcolor="#FFFFFF" style="margin: 0;">
<form name="input_form" method="get" action="/scripts/rds/cgilkup.exe?
+">
<input name="program_id" id="program_id" type="hidden" value="$v_progr
+am_id">
<input name="position" id="position" type="hidden" value="$v_position"
+>
<input name="pname" id="pname" type="hidden" value="$v_pname">
<input name="pvalue" id="pvalue" type="hidden" value="$v_pvalue">
<input name="paction" id="paction" type="hidden" value="1">
<table cellpadding="7" cellspacing="0" border="1" style="width: 400p
+x; height: 250px; background-color: #FFFFFF;">
<tbody>
<tr>
<td valign="top" style="height: 42px; width: 400px;">
<table border="0" cellpadding="0" cellspacing="0" width="100%
+">
<tr><td>
<font style="$fnt_stylen">Filter $lku_prompt by:</font><br>
<input name="filter" id="filter" type="text" size="40" maxlen
+gth="40" value="$v_filter" style="$inp_style">
</td><td>
<button name="search_btn" id="search_btn" value="Search" oncl
+ick="lku_search()" style="$btn_style"><img src="/image/csl_search.gif
+"></button>
<br style="height: 1px;">
<button type="button" name="set_btn" id="set_btn" value="Set"
+ onclick="lku_set()" style="$btn_style"><img src="/image/csl_select.g
+if"></button>
<br style="height: 1px;">
<button type="button" name="finish_btn" id="finish_btn" value
+="Finish" onclick="lku_done()" style="$btn_style"><img src="/image/cs
+l_done.gif"></button>
</td></tr>
</table>
</td>
</tr>
<tr>
<td><font size="-1">
<div id="CS_FTree" style="border: 1px solid rgb(164,164,255); backgrou
+nd-color: white; width: 376px; height: 146px; overflow: scroll;">
<ul id="menuList" class="folder">
END-HTML
if ($v_grep =~ /\w/) {
search_dir($rsLKU,0);
} else {
print @print_dir;
} if ($v_fcnt) {
$v_fcnt_msg = "";
} else {
$v_fcnt_msg = " No files found";
}
print <<"END-HTML";
</ul>$v_fcnt_msg
</div>
</td>
</tr>
</tbody>
</table>
</form>
</body></html>
END-HTML
}
#####################################
sub valRun_parameter {
my ($dbh,$user_id,$program_id,$pos) = @_;
my $rsSQL;
my $sth;
#####################################
$strSQL = << "end-sql";
select
p.position,
rtrim(p.agent_id) agent_id,
rtrim(p.lookup_id) lookup_id,
p.user_input_mask,
p.allow_multiple,
p.type,
p.format,
p.prompt,
rtrim(p.value) value,
p.required,
p.upper_bound,
p.lower_bound,
rtrim(p.input_mask_id) input_mask_id,
description,
isnull((select a.editable from Run_parameters a where a.program_id =
+p.agent_id
and a.editable = 'Y' group by a.editable),'N') has_filter
from Run_parameters p
where p.program_id = \'$program_id\'
and p.position = $pos
and p.editable = 'Y'
end-sql
eval {
$sth = $dbh->prepare($strSQL);
$sth->execute();
#Load into an array
$rsSQL = $sth->fetchall_arrayref(
{position => 1, agent_id => 1, lookup_id => 1,
user_input_mask => 1, allow_multiple => 1,
type => 1, format => 1, prompt => 1, value => 1,
required => 1, upper_bound => 1, lower_bound => 1,
input_mask_id => 1, description => 1, has_filter => 1});
};
if( @$rsSQL > 0 ) { return ($rsSQL); }
return('');
}
#####################################
sub getAgentData {
my ($dbh,$agent_id,$input_mask_id,$filter,$pval) = @_;
my $rsInput_masks;
my @rsAgent = ();
my $sth;
my $cmd;
#####################################
if ($input_mask_id ne "" && $input_mask_id ne " ") {
$strSQL = <<"end-sql";
select im.value
from Input_masks im, Groups g
where im.input_mask_id = \'$input_mask_id\'
and g.group_id = im.user_id
and g.user_id = \'$v_user_id\'
union
select im.value
from Input_masks im, Groups g
where im.input_mask_id = \'$input_mask_id\'
and im.user_id = \'$v_user_id\'
end-sql
$sth = $dbh->prepare($strSQL);
$sth->execute();
#Load into an array reference
$rsInput_masks = $sth->fetchall_arrayref(
{ value => 1 } );
foreach $val (@$rsInput_masks) { $hshInput_masks{$val->{value}} = "Y"
+; }
} else {
$hshInput_masks{ALL_VALUES} = "Y";
}
if ($pval =~ /\S/) {
$cmd = "$CGI\\cgionline.exe \"$v_user_id\" \"$agent_id\" \"$filter~
+$pval\"";
} else {
$cmd = "$CGI\\cgionline.exe \"$v_user_id\" \"$agent_id\" \"$filter\
+"";
}
eval { open(R_AGENT, "$cmd |"); };
if ($@) { print $@; return; }
# Read past the cgi headers
while ( !(<R_AGENT> =~ /^$/) ) { ; }
my @trow = ();
my $rowcntmax = 0;
while (<R_AGENT>) {
if ($rowcntmax++ > 10000) { last; }
chomp();
@trow = split(/~/,$_,-1);
($value,$display,$pvalue,$type) = ("$trow[0]","$trow[1]","$trow[2]",
+"$trow[3]");
$value =~ s/^\s*//g; $value =~ s/\s*$//g;
$display =~ s/^\s*//; $display =~ s/\s*$//;
$display =~ s/ / /g;
$pvalue =~ s/^\s*//; $pvalue =~ s/\s*$//;
$type =~ s/^\s*//; $type =~ s/\s*$//;
unless ($display) { $display = $value; }
if ("$value" ne "" && ($AllValues{$pval} || $pvalue eq $pval)
&& ($hshInput_masks{ALL_VALUES} || $hshInput_masks{$value})) {
my %tmp_hash = (sequence => "1", value => $value, display => $disp
+lay, pvalue => $pvalue, type => $type);
push @rsAgent, \%tmp_hash;
}
}
close(R_AGENT);
if (@rsAgent) { return(\@rsAgent); }
return("");
}
#####################################
sub getLookups {
my ($dbh,$lookup_id,$input_mask_id,$filter) = @_;
my $rsLookups;
my $sth;
#####################################
$filter =~ s/'/''/g;
if ($input_mask_id eq "" || $input_mask_id eq " ") {
$strSQL = <<"end-sql";
select
lu.sequence, lu.value, lu.display
from
Lookups lu
where lu.lookup_id = \'${lookup_id}\'
and upper(lu.display) like upper(\'%${filter}%\')
order by
lu.sequence, lu.display
end-sql
} else {
$strSQL = <<"end-sql";
select
lu.sequence, lu.value, lu.display
from
Lookups lu
where lu.lookup_id = \'${lookup_id}\'
and upper(lu.display) like upper(\'%${filter}%\')
and exists
(select 'x' from Input_masks im, Groups g
where im.input_mask_id = \'$input_mask_id\'
and im.user_id = g.group_id
and g.user_id = \'$v_user_id\'
and im.value = 'ALL_VALUES'
)
union
select
lu.sequence, lu.value, lu.display
from
Lookups lu
where lu.lookup_id = \'${lookup_id}\'
and upper(lu.display) like upper(\'%${filter}%\')
and exists
(select 'x' from Input_masks im
where im.input_mask_id = \'$input_mask_id\'
and im.user_id = \'$v_user_id\'
and im.value = 'ALL_VALUES'
)
union
select
lu.sequence, lu.value, lu.display
from
Lookups lu, Input_masks im, Groups g
where lu.lookup_id = \'${lookup_id}\'
and upper(lu.display) like upper(\'%${filter}%\')
and im.input_mask_id = \'${input_mask_id}\'
and im.value = lu.value
and im.user_id = g.group_id
and g.user_id = \'$v_user_id\'
union
select
lu.sequence, lu.value, lu.display
from
Lookups lu, Input_masks im
where lu.lookup_id = \'${lookup_id}\'
and upper(lu.display) like upper(\'%${filter}%\')
and im.input_mask_id = \'${input_mask_id}\'
and im.value = lu.value
and im.user_id = \'${v_user_id}\'
order by 1,3
end-sql
}
#print "$strSQL\n";
$sth = $dbh->prepare($strSQL);
$sth->execute();
#Load into an array reference
$rsLookups = $sth->fetchall_arrayref(
{ sequence => 1, value => 1, display => 1 } );
if ( @$rsLookups ) { return($rsLookups); }
return('');
} # End procedure getLookups
#####################################
sub getDistrib_users {
my ($dbh, $site_id, $user_id, $filter) = @_;
my $rsSQL;
my $sth;
#####################################
$filter =~ s/ *$//; $filter2 = lc($filter); $filter = uc($filter);
if ($filter) {
$filter =~ s/'/''/g; $filter =~ s/ /%/g;
$filter1 = " and (u.user_id like \'$filter2%\'"
. " or upper(u.first_name + ' ' + u.last_name)"
. " like \'%$filter%\')";
$filter2 = " and (upper(gd.description) like \'%$filter%\'"
. " or upper(gd.group_id) like \'$filter%\')";
}
$strSQL = << "end-sql";
select
1 sequence,
u.last_name,
isnull(rtrim(u.first_name),u.user_id) first_name,
u.user_id value,
u.user_id + ' -- ' + isnull(rtrim(u.first_name),u.user_id) + ' ' + u.
+last_name display
from Users u
where u.user_privilege > -1 $filter1
union select distinct
2,
gd.group_id,
'GROUP',
gd.group_id,
gd.group_id + ' -- ' + gd.description
from Group_defs gd, Groups g, Users u
where gd.group_id = g.group_id
and g.user_id = u.user_id $filter2
order by 1,2,3,4
end-sql
# print "$strSQL\n";
eval {
$sth = $dbh->prepare($strSQL);
$sth->execute();
};
if ($@) { print "$@\n"; }
#Load into an array
$rsSQL = $sth->fetchall_arrayref(
{ sequence => 1,
last_name => 1,
first_name => 1,
user_id => 1,
value => 1,
display => 1});
if( @$rsSQL > 0 ) { return ($rsSQL); }
return('');
}
#####################################
sub getDistrib_mails {
my ($dbh, $site_id, $filter) = @_;
my $rsSQL;
my $sth;
my $filter1 = "";
my $filter2 = "";
#####################################
$filter =~ s/ *$//; $filter2 = lc($filter); $filter = uc($filter);
if ($filter) {
$filter =~ s/'/''/g; $filter =~ s/ /%/g;
$filter1 = " and (u.user_id like \'$filter2%\'"
. " or upper(u.first_name + ' ' + u.last_name)"
. " like \'%$filter%\'"
. " or m.email_address like \'$filter2%\')";
$filter2 = " and (upper(gd.description) like \'%$filter%\'"
. " or upper(gd.group_id) like \'%$filter%\')";
}
$strSQL = << "end-sql";
select
0 sequence,
m.email_address,
u.last_name,
u.first_name,
m.email_address value,
m.email_address + ' -- ' + u.first_name + ' ' +u.last_name display
from Mails m, Users u, Default_lists d
where m.user_id = u.user_id
and m.user_id = d.recipient
and d.type in ('E','L')
and d.user_id = \'$user_id\' $filter1
union select
1,
m.email_address,
u.last_name,
u.first_name,
m.email_address value,
m.email_address + ' -- ' + u.first_name + ' ' +u.last_name display
from Mails m, Users u
where m.user_id = u.user_id
and u.user_privilege > -1 $filter1
union select
2,
gd.group_id,
gd.description,
'',
gd.group_id,
gd.group_id + ' -- ' + gd.description
from Mails m, Users u, Groups g, Group_defs gd
where gd.group_id = g.group_id
and m.user_id = g.user_id
and m.user_id = u.user_id
and u.user_privilege > -1 $filter2
order by 1,2
end-sql
# print "$strSQL\n";
$sth = $dbh->prepare($strSQL);
$sth->execute();
#Load into an array
$rsSQL = $sth->fetchall_arrayref(
{ sequence => 1,
email_address => 1,
last_name => 1,
first_name => 1,
value => 1,
display => 1});
if( @$rsSQL ) { return ($rsSQL); }
return('');
}
############################################################
sub print_dir_init {
############################################################
my ($rsDir,$idx,$parent) = @_;
my $i;
my $max = scalar(@$rsDir);
if ($idx > 0) {
return($idx) if ($rsDir->[$idx]->{pvalue} ne $parent);
} return($idx+1) if ($rsDir->[$idx]->{value} !~ /\w/);
for ($i = $idx; $i < $max; $i++) {
last if ($rsDir->[$idx]->{pvalue} ne $rsDir->[$i]->{pvalue});
while ("DIR" eq $rsDir->[$i]->{type} && $i < $max) {
$dir_ID = sprintf("%06d",$i);
print "init_FTree(\"_Tree_${dir_ID}\",\"_Tree_${dir_ID}Actuator\")
+;\n";
push @print_dir,"<li class=\"foldertop\">"
. "<a href=\"#\" id=\"_Tree_${dir_ID}Actuator\" "
. "class=\"actuator\">$rsDir->[$i]->{display}</a>"
. "<ul id=\"_Tree_${dir_ID}\" class=\"folder\">\n";
$i = print_dir_init($rsDir,$i+1,$rsDir->[$i]->{value});
push @print_dir,"</ul></li>\n";
last if ($rsDir->[$idx]->{pvalue} ne $rsDir->[$i]->{pvalue});
$v_fcnt += 1;
}
last if ($rsDir->[$idx]->{pvalue} ne $rsDir->[$i]->{pvalue} || $i >=
+ $max);
if("FIL" eq $rsDir->[$i]->{type}) {
push @print_dir,"<li>"
. "<a href=\"javascript:lku_set('"
. escape_str($rsDir->[$i]->{value})
. "')\">$rsDir->[$i]->{display}</a></li>\n";
$v_fcnt += 1;
}
}
return($i);
}
############################################################
sub search_dir {
############################################################
my ($rsDir,$idx,$parent) = @_;
my $i;
my $max = scalar(@$rsDir);
if ($idx > 0) {
return($idx) if ($rsDir->[$idx]->{pvalue} ne $parent);
} return($idx+1) if ($rsDir->[$idx]->{value} !~ /\w/);
for ($i = $idx; $i < $max; $i++) {
last if ($rsDir->[$idx]->{pvalue} ne $rsDir->[$i]->{pvalue});
while ("DIR" eq $rsDir->[$i]->{type} && $i < $max) {
$i = search_dir($rsDir,$i+1,$rsDir->[$i]->{value});
last if ($rsDir->[$idx]->{pvalue} ne $rsDir->[$i]->{pvalue});
}
last if ($rsDir->[$idx]->{pvalue} ne $rsDir->[$i]->{pvalue} || $i >=
+ $max);
if ("FIL" eq $rsDir->[$i]->{type}
&& $rsDir->[$i]->{display} =~ /$v_grep/i) {
print "<li>",
"<a href=\"javascript:lku_set('",escape_str($rsDir->[$i]->{value
+}),
"')\">",$rsDir->[$i]->{display},"</a></li>\n";
$v_fcnt += 1;
}
}
return($i);
}