homepage Welcome to WebmasterWorld Guest from 54.226.80.55
register, free tools, login, search, pro membership, help, library, announcements, recent posts, open posts,
Become a Pro Member
Home / Forums Index / Code, Content, and Presentation / Perl Server Side CGI Scripting
Forum Library, Charter, Moderators: coopster & jatar k & phranque

Perl Server Side CGI Scripting Forum

    
Display Number of records for a search
What im looking for is something where i could include what im searching fo
samselimi




msg:3869912
 7:02 pm on Mar 13, 2009 (gmt 0)

Please bear with me, this might be a little long winded for something very simple...

I want to display something like a report from my text database.

let me explain.
for instance if i search for...
http://example.com/myscript.cgi?feild1=baseball&feild2=closed

the output shows "8 records found" and displays those 8 records...

and if i search for...
http://example.com/myscript.cgi?feild1=baseball&feild2=open

I would get "6 records found" and it would display those 6 records...

Thats fine but...
What im looking for is something where i could include what im searching for in the script and the output would just show me a count. Kinda like this...

status Baseball football
open 6 12
closed 8 10

I hope that makes sense... Please help.

[edited by: phranque at 1:06 am (utc) on Mar. 14, 2009]
[edit reason] exemplified urls [/edit]

 

janharders




msg:3869931
 7:17 pm on Mar 13, 2009 (gmt 0)

I guess you'll have to go into more detail.
Is it a local database you want to query or is it some website/webservice, you want to scrape?

If it's a local database, that's easy enough to do, usually, but we'd need a general idea of what the tables look like. You may be able to do it yourself: copy the myscript.cgi to mynewscript.cgi and comment out all output (eg "print ..." becomes "#print ...", that is, unless you're using a templating-system, in which case you'll probably just have to work on the template) until you end up with just what you want. test it after you've deleted a few lines, to make sure it still works. once you've dived into the code, you'll start to understand it.
building a query => amount-table is just a matter of adding a loop around the code that fetches the numbers from the database. Once you've stripped all unnecessary output, that'll be easy to do.

samselimi




msg:3869948
 8:06 pm on Mar 13, 2009 (gmt 0)

ok, i think i understand...

it is a local database. (although i would love to learn the scraping too)

so, from what i got from your post i would be able to run mynewscript.cgi (it would already be holding the predefined searches i would need to display the totals for.)

now i'm at the point where i commented enough out to where only the "100 records found" and nothing else when i run mynewscript.cgi.

I think i just need help with the looping. and making sure i can search for more that one term per line. like feild1 and feild2.

janharders




msg:3870257
 12:27 pm on Mar 14, 2009 (gmt 0)

if your script isn't too big, post it here. remember to delete database passwords or any site-specifics first.

if it's still big: remove the lines you commented out and/or try to identify the part where it actually does the searching.

generally speaking, it's pretty easy. You have to figure out how the script uses the parameters you pass in and change those parts.

so, for example, if your script uses CGI.pm and runs the search with

search( $CGI->param('field1'), $CGI->param('field2') );

you'd say

my @fields1 = $CGI->param('field1');
my @fields2 = $CGI->param('field2');
for(my $i = 0; $i < scalar @fields1; $i++)
{
search( $fields1[$i], $fields2[$i] );
}

if it's not using CGI.pm (you can see if it does by looking for "use CGI"), it might be a little more complicated and you'll have to change it to using CGI.pm (some scripts use a sub routine to get the data that has been passed to them, but those routines are usually lacking features)

as an example, here's a little perl-script, that'll just print the parameters it was given

#!/usr/bin/perl -w
use strict;
use CGI;

print "Content-type: text/html\n\n";
my $CGI = new CGI;
for my $searchterm ($CGI->param('field1'))
{
print $searchterm . "<br />";
}

so if you've called it as "test.pl?field1=test&field1=test2", it'll print
test
test2

if you've called it as "test.pl?field1=test&field1=test2&field1=test3&field1=test4", it'll print
test
test2
test3
test4

note that I've used "field1" and "field2" as I believed the "feild1" in your original post to be a typo ;)

samselimi




msg:3870565
 2:50 am on Mar 15, 2009 (gmt 0)

I got this script from a template.

I think this is how it's searching:

#!/usr/bin/perl
use CGI;
$query = new CGI;

#E1. Get the data passed from user
$field1=$query->param('field1');
$field1work=lc($field1);
#E1b. The line below chops characters that cause problems in Perl word searches
$field1work=~tr/[a-zA-Z0-9 \.\,\?\@\-]/ /cd;
if ($field1work eq "select"){
$field1work="";
$field1="";}
$field1pass="$field1";

#E1. Get the data passed from user
$field2=$query->param('field2');
$field2work=lc($field2);
#E1b. The line below chops characters that cause problems in Perl word searches
$field2work=~tr/[a-zA-Z0-9 \.\,\?\@\-]/ /cd;
if ($field2work eq "select"){
$field2work="";
$field2="";}
$field2pass="$field2";
##############

This is the part where it displays like "3 matches found..."

#STEP H================================
#H1. Read each line of the data file, compare with search words

foreach $line (@all){
$line=~s/\n//g;
$loopsaround++;

$checkleng=length($line);
if ($checkleng<2){next};

$linetemp1=lc($line);

#H1a. Support for European characters. Uncomment and replace with your
#character set in brackets for all non-English Characters. See help files.
#$linetemp1=~tr/[]/e/;
#$linetemp1=~tr/[]/a/;
#$linetemp1=~tr/[]/c/;
#$linetemp1=~tr/[]/i/;
#$linetemp1=~tr/[]/o/;
#$linetemp1=~tr/[]/u/;

($field1,$field2,$skipthisfield)=split (/$delimiter/,$linetemp1);

#H9. This line specifies the fields to sort results by
#See help databases for patches to allow various kinds of sorts
$line="$delimiter$loopsaround$delimiter$line";

#H9.5 This line removes stray leading spaces before sorting your results
$line=~s/^ +//;

$increcount=0;
#H12. Look for matches in field named field1
if (($field1 =~/\b$field1one/ && $field1 =~/\b$field1two/ && $field1 =~/\b$field1three/ && $field1 =~/\b$field1four/ && $field1 =~/\b$field1five/ && $field1=~/\b$field1six/ && $field1=~/\b$field1seven/) !$field1work) {
$increcount++;}

#H12. Look for matches in field named field2
if (($field2 =~/\b$field2one/ && $field2 =~/\b$field2two/ && $field2 =~/\b$field2three/ && $field2 =~/\b$field2four/ && $field2 =~/\b$field2five/ && $field2=~/\b$field2six/ && $field2=~/\b$field2seven/) !$field2work) {
$increcount++;}

if ($increcount==2){
push (@keepers,$line);}}

#STEP J================================
#J1. Sort matches stored in array. Currently turned off.
#@keepers=sort(@keepers);

#J2. Get and display number of matches found
$length1=@keepers;

#J3. If the number of matches is less than enditem, adjust
if ($length1<$enditem){
$enditem=$length1;
$displaystat="Y";}

#J4. The first field about to display
$disstart=$startitem+1;

#J5. Show user total number of matches found
if ($length1){
print "$length1 Matches Found (displaying $disstart to $enditem)<P>\n";
} else {
print "Your search found zero records, please try again.<P>\n";}

The tests in your last post worked when i tried them. but there has go to be a way to put the search terms like "test.pl?field1=test&field1=test2..." inside the script so when i run the script, I only get the record count.

samselimi




msg:3872588
 7:07 pm on Mar 17, 2009 (gmt 0)

Here is something else i have tried...

The only problem is this script doesn't look line by line it only counts the entire datafile.

#!/usr/bin/perl

use CGI;
$query = new CGI;

open (my $IN , '<', '/datafiles/tickets.cgi') or die "$!";

my $text = do {local $/; <$IN>};#slurp file into a scalar
$delimiter="\\¦";

print "Content-type: text/html\n\n";
#=======================================
#=======================================
#============Record Count===============
#=======================================
#=======================================

#=======================================
#=================COBC==================
#=======================================
my $cobcpnd = 0;
$cobcpnd++ while ($text =~ m/\bCOBC\b/gi);
my $cobcpnd = 0;
$cobcpnd++ while ($text =~ m/\bPND\b/gi);

my $cobccls = 0;
$cobccls++ while ($text =~ m/\bCLS\b/gi);
$cobccls++ while ($text =~ m/\bCOBC\b/gi);

my $cobctotal = 0;
$cobctotal++ while ($text =~ m/\bCOBC\b/gi);
#=======================================

#=======================================
#=============DO NOT CALL===============
#=======================================
my $dncpnd = 0;
$dncpnd++ while ($text =~ m/\b50640382\b/gi);
$dncpnd++ while ($text =~ m/\bPND\b/gi);

my $dnccls = 0;
$dnccls++ while ($text =~ m/\bCLS\b/gi);
$dnccls++ while ($text =~ m/\b50640382\b/gi);

my $dnctotal = 0;
$dnctotal++ while ($text =~ m/\bCLS\b/gi);
$dnctotal++ while ($text =~ m/\bPND\b/gi);
$dnctotal++ while ($text =~ m/\b50640382\b/gi);
#=======================================

#=======================================
#=================TOTAL=================
#=======================================
my $pnd = 0;
$totalpnd++ while ($text =~ m/\bPND\b/gi);

my $cls = 0;
$totalcls++ while ($text =~ m/\bCLS\b/gi);

my $total = 0;
$totaltotal++ while ($text =~ m/\bCLS\b/gi);
$totaltotal++ while ($text =~ m/\bPND\b/gi);
#=======================================

#=======================================
#=============Start Output==============
#=======================================
print "<table border=1><tr valign=top>\n";
print "<td>Status</td>\n";
print "<td>COBC/EEO Training</td>\n";
print "<td>DO NOT CALL</td>\n";
print "<td>Total</td>\n";
print "</tr>\n";
#==============Pending==================
print "<tr valign=top>\n";
print "<td>Pending</td>\n";
print "<td>$cobcpnd</td>\n";
print "<td>$dncpnd</td>\n";
print "<td>$totalpnd</td>\n";
print "</tr>\n";
#==============Closed===================
print "<tr valign=top>\n";
print "<td>Closed</td>\n";
print "<td>$cobccls</td>\n";
print "<td>$dnccls</td>\n";
print "<td>$totalcls</td>\n";
print "</tr>\n";
#==============Total====================
print "<tr valign=top>\n";
print "<td>Total</td>\n";
print "<td>$cobctotal</td>\n";
print "<td>$dnctotal</td>\n";
print "<td>$totaltotal</td>\n";
print "</tr>\n";
#================END====================

janharders




msg:3873186
 12:32 pm on Mar 18, 2009 (gmt 0)

something like this should get you closer.
should be called like
script.pl?field1=baseball&field2=closed&field1=baseball&field2=open

haven't tested it, but it might just do the job. btw, I always recommend "use strict;". It enforces a cleaner style and catches typos and the sorts. keeps you out of trouble.

#!/usr/bin/perl
use CGI;
$query = new CGI;

my @fields1 = $query->param('field1');
my @fields2 = $query->param('field2');

for(my $i = 0; $i < scalar @fields1; $i++)
{
$field1 = $fields1[$i];
$field2 = $fields2[$i];
#E1. Get the data passed from user

$field1work=lc($field1);
#E1b. The line below chops characters that cause problems in Perl word searches
$field1work=~tr/[a-zA-Z0-9 \.\,\?\@\-]/ /cd;
if ($field1work eq "select"){
$field1work="";
$field1="";}
$field1pass="$field1";

#E1. Get the data passed from user

$field2work=lc($field2);
#E1b. The line below chops characters that cause problems in Perl word searches
$field2work=~tr/[a-zA-Z0-9 \.\,\?\@\-]/ /cd;
if ($field2work eq "select"){
$field2work="";
$field2="";}
$field2pass="$field2";
##############

# ...

#STEP H================================
#H1. Read each line of the data file, compare with search words

foreach $line (@all){
$line=~s/\n//g;
$loopsaround++;

$checkleng=length($line);
if ($checkleng<2){next};

$linetemp1=lc($line);

#H1a. Support for European characters. Uncomment and replace with your
#character set in brackets for all non-English Characters. See help files.
#$linetemp1=~tr/[]/e/;
#$linetemp1=~tr/[]/a/;
#$linetemp1=~tr/[]/c/;
#$linetemp1=~tr/[]/i/;
#$linetemp1=~tr/[]/o/;
#$linetemp1=~tr/[]/u/;

($field1,$field2,$skipthisfield)=split (/$delimiter/,$linetemp1);

#H9. This line specifies the fields to sort results by
#See help databases for patches to allow various kinds of sorts
$line="$delimiter$loopsaround$delimiter$line";

#H9.5 This line removes stray leading spaces before sorting your results
$line=~s/^ +//;

$increcount=0;
#H12. Look for matches in field named field1
if (($field1 =~/\b$field1one/ && $field1 =~/\b$field1two/ && $field1 =~/\b$field1three/ && $field1 =~/\b$field1four/ && $field1 =~/\b$field1five/ && $field1=~/\b$field1six/ && $field1=~/\b$field1seven/) !$field1work) {
$increcount++;}

#H12. Look for matches in field named field2
if (($field2 =~/\b$field2one/ && $field2 =~/\b$field2two/ && $field2 =~/\b$field2three/ && $field2 =~/\b$field2four/ && $field2 =~/\b$field2five/ && $field2=~/\b$field2six/ && $field2=~/\b$field2seven/) !$field2work) {
$increcount++;}

if ($increcount==2){
push (@keepers,$line);}}

#STEP J================================
#J1. Sort matches stored in array. Currently turned off.
#@keepers=sort(@keepers);

#J2. Get and display number of matches found
$length1=@keepers;

#J3. If the number of matches is less than enditem, adjust
if ($length1<$enditem){
$enditem=$length1;
$displaystat="Y";}

#J4. The first field about to display
$disstart=$startitem+1;
print "search: " . $field1 . ", " . $field2 . "\n";
#J5. Show user total number of matches found
if ($length1){
print "$length1 Matches Found (displaying $disstart to $enditem)<P>\n";
} else {
print "Your search found zero records, please try again.<P>\n";}
}

krugs




msg:3873562
 6:37 pm on Mar 18, 2009 (gmt 0)

this might backfire a bit since tr/// has no concept of character classes:

$field2work=~tr/[a-zA-Z0-9 \.\,\?\@\-]/ /cd;

its properly written like so if I understand what it wants to do: delete any character not found in the search pattern:

$field2work =~ tr/a-zA-Z0-9.,?@-//cd;

tr/// has no concept of pattern matching or quantifiers (only ranges) so none of the non-word characters needs a backslash to escape them.

samselimi




msg:3878588
 4:57 pm on Mar 25, 2009 (gmt 0)

I don't know. it doesn't seem to be working like i want it to...

samselimi




msg:3878628
 5:42 pm on Mar 25, 2009 (gmt 0)


System: The following 2 messages were spliced on to this thread from: http://www.webmasterworld.com/perl/3878626.htm [webmasterworld.com] by phranque - 4:25 pm on Mar. 25, 2009 (utc -7)


I have been trying to figure this out for a while now. the code below is put together from different parts of things i have found on this site.

right now the code below uses a word search to count all of the records and puts the results in a table.

Status____COBC__DNC___Total
Pending___1104__1098___916
Closed____564___558____376
Total_____188___182____1292

The problem is, i need it to search each line not the entire file.

It counts "pnd"(status) and anything with "COBC"(course name) together.

So the 1st item in the table is 1104 instead of 12, because it counted all of PND in the file then all of COBC in the file and added them together. (I realize that is what the code is doing) i need help to tell the code to look for PND and COBC that are on the same line and then count the data file for that unique search.

Maybe word search is not the way to go. But im kinda stuck...

#!/usr/bin/perl

use CGI;
$query = new CGI;

open (my $IN , '<', 'd:/inetpub/cgi-bin/tickets.cgi') or die "$!";

my $text = do {local $/; <$IN>};#slurp file into a scalar
$delimiter="\\";

print "Content-type: text/html\n\n";
#============Record Count===============
#=================COBC==================
my $cobcpnd = 0;
$cobcpnd++ while ($text =~ m/\bCOBC\b/gi);
$cobcpnd++ while ($text =~ m/\bPND\b/gi);

my $cobccls = 0;
$cobccls++ while ($text =~ m/\bCLS\b/gi);
$cobccls++ while ($text =~ m/\bCOBC\b/gi);

my $cobctotal = 0;
$cobctotal++ while ($text =~ m/\bCOBC\b/gi);
#=============DO NOT CALL===============
my $dncpnd = 0;
$dncpnd++ while ($text =~ m/\bDNC\b/gi);
$dncpnd++ while ($text =~ m/\bPND\b/gi);

my $dnccls = 0;
$dnccls++ while ($text =~ m/\bCLS\b/gi);
$dnccls++ while ($text =~ m/\bDNC\b/gi);

my $dnctotal = 0;
$dnctotal++ while ($text =~ m/\bDNC\b/gi);
#=================TOTAL=================
my $pnd = 0;
$totalpnd++ while ($text =~ m/\bPND\b/gi);

my $cls = 0;
$totalcls++ while ($text =~ m/\bCLS\b/gi);

my $total = 0;
$totaltotal++ while ($text =~ m/\bCLS\b/gi);
$totaltotal++ while ($text =~ m/\bPND\b/gi);

#=============Start Output==============
print "<table border=8 bordercolor=green><tr valign=top>\n";
print "<td>Status</td>\n";
print "<td>COBC/EEO Training</td>\n";
print "<td>DO NOT CALL</td>\n";
print "<td>Total</td>\n";
print "</tr>\n";
#==============Pending==================
print "<tr valign=top>\n";
print "<td>Pending</td>\n";
print "<td>$cobcpnd</td>\n";
print "<td>$dncpnd</td>\n";
print "<td>$totalpnd</td>\n";
print "</tr>\n";
#==============Closed===================
print "<tr valign=top>\n";
print "<td>Closed</td>\n";
print "<td>$cobccls</td>\n";
print "<td>$dnccls</td>\n";
print "<td>$totalcls</td>\n";
print "</tr>\n";
#==============Total====================
print "<tr valign=top>\n";
print "<td>Total</td>\n";
print "<td>$cobctotal</td>\n";
print "<td>$dnctotal</td>\n";
print "<td>$totaltotal</td>\n";
print "</tr>\n";
#================END====================

Here is what i want the output to be...
Status____COBC__DNC___Total
Pending___12____153___916
Closed____176___29____376
Total_____188___182___1292

phranque




msg:3878867
 10:55 pm on Mar 25, 2009 (gmt 0)

welcome to WebmasterWorld [webmasterworld.com], samselimi!

you probably want to use a while or for loop to look at your input one record at a time and then do something like this for each counter:
$cobcpnd++ if (($record =~ m/\bCOBC\b/gi) && ($record =~ m/\bPND\b/gi));

samselimi




msg:3879555
 7:20 pm on Mar 26, 2009 (gmt 0)

Thanks Phranque, The problem is I don't know exactly how to do this. How do I add a while or for loop?

phranque




msg:3879688
 10:19 pm on Mar 26, 2009 (gmt 0)

print "Content-type: text/html\n\n";
while ($record = <IN>){
# do some stuff to/with $record
}
#=============Start Output==============

krugs




msg:3879865
 3:48 am on Mar 27, 2009 (gmt 0)

That will have a big affect on the file processing because they are reading the file into a scalar first:


open (my $IN , '<', 'd:/inetpub/cgi-bin/tickets.cgi') or die "$!";
my $text = do {local $/; <$IN>};#slurp file into a scalar

phranque




msg:3879916
 6:47 am on Mar 27, 2009 (gmt 0)

i was was assuming the file was being read a record at a time instead, but if you prefer the slurp or want it for efficiency:

my $text = do {local $/; <$IN>};#slurp file into a scalar
print "Content-type: text/html\n\n";
foreach my $record (split /\n/, $text){
# do some stuff to/with $record
}
#=============Start Output==============

Global Options:
 top home search open messages active posts  
 

Home / Forums Index / Code, Content, and Presentation / Perl Server Side CGI Scripting
rss feed

All trademarks and copyrights held by respective owners. Member comments are owned by the poster.
Home ¦ Free Tools ¦ Terms of Service ¦ Privacy Policy ¦ Report Problem ¦ About ¦ Library ¦ Newsletter
WebmasterWorld is a Developer Shed Community owned by Jim Boykin.
© Webmaster World 1996-2014 all rights reserved