Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Compiling a cgi script with pp

by nmork (Novice)
on Jul 11, 2018 at 20:56 UTC ( [id://1218347]=perlquestion: print w/replies, xml ) Need Help??

nmork has asked for the wisdom of the Perl Monks concerning the following question:

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)", "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbs +p;", "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbs +p;", "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbs +p;", "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbs +p;", "</option>\n"; } else { print "<option value=\"\">", "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbs +p;", "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbs +p;", "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbs +p;", "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbs +p;", "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&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 = "&nbsp;&nbsp;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/ /&nbsp;/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); }

Replies are listed 'Best First'.
Re: Compiling a cgi script with pp
by nysus (Parson) on Jul 11, 2018 at 23:48 UTC

    Thank you for asking a question and contributing to our community. This is just a friendly note to let you know you can break up long posts with the <readmore> tag. You can refer to Writeup Formatting Tips for more details.

    $PM = "Perl Monk's";
    $MCF = "Most Clueless Friar Abbot Bishop Pontiff Deacon Curate Priest";
    $nysus = $PM . ' ' . $MCF;
    Click here if you love Perl Monks

Re: Compiling a cgi script with pp
by Anonymous Monk on Jul 12, 2018 at 13:04 UTC
    Hi . which perl are you using and how did you create the exe (what commands)?
Re: Compiling a cgi script with pp
by Anonymous Monk on Jul 14, 2018 at 19:54 UTC

    Hi

    What webserver are you using? Are you using cygwin?

Re: Compiling a cgi script with pp
by Anonymous Monk on Jul 12, 2018 at 14:03 UTC
    "Thanks for posting the complete source-code. Here, let me just drop everything I'm doing and go debug it for you ..."

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1218347]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others contemplating the Monastery: (4)
As of 2024-03-29 00:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found