#!/bin/perl use strict; my @preforder = ('ORGANIZATION','YEAR_FOUNDED','DIRECTOR','DIRECTORS','DIRECTOR(S)', 'CHAIRPERSON','P.I.','PRESIDENT','CEO/PRESIDENT','VICE PRESIDENT', 'CHIEF EXECUTIVE','SECRETARY GENERAL','SECRETARY', 'ADDRESS','ADDRESS (HOME)','CITY','STATE','COUNTRY', 'CONTACT','TELEPHONE','FAX','FAX ', 'PH/FAX', 'E-MAIL','E-MAIL ','EMAIL', 'WEBSITE','WEB','WORKAREA','SERVICES','WORK SERVICES', 'LASTMOD'); open DATABASE, "/home/webpages/t8/people/rajan/AIDS-india/NGO/ingo.html" || errout($?); my @indianstates = ("Andhra Pradesh", "Arunachal Pradesh", "Assam", "Bihar", "Chattisgarh", "Goa", "Gujarat", "Haryana", "Himachal Pradesh", "Jammu and Kashmir", "Jharkhand", "Karnataka", "Kerala", "Madhya Pradesh", "Maharashtra", "Manipur", "Meghalaya", "Mizoram", "Nagaland", "Orissa", "Punjab", "Rajasthan", "Sikkim", "TamilNadu", "Tripura", "Uttar Pradesh", "Uttaranchal", "West Bengal"); my @indianuts = ("Andaman and Nicobar", "Chandigarh", "Dadra and Nagar Haveli", "Daman and Diu", "New Delhi", "Lakshadweep", "Pondicherry"); my @records = (); my $state; my $currentrec; my $currentfield; while () { chomp; if (/(.*)<\/U>/i) { $state = $1; push @records, $currentrec if defined $currentrec; undef $currentrec; undef $currentfield; next; } if (/^\s* "search" }; if (grep uc($_) eq uc($state), (@indianstates, @indianuts)) { $currentrec->{COUNTRY} = "INDIA"; $currentrec->{STATE} = $state; } elsif (uc ($state) ne "INTERNATIONAL") { $currentrec->{COUNTRY} = $state; } } else { next unless $currentrec; } $currentrec->{uc "$1"} = $2; $currentfield = \$currentrec->{uc "$1"}; } push @records, $currentrec if defined $currentrec; my $searchpat = $ENV{QUERY_STRING}; $searchpat =~ s/([^&=]+=[^&]*)(&?)(.*)/$3$2$1/; $searchpat =~ s/[^=&]+=\s*\&//g; $searchpat =~ s/(\&|^)[^=&]+=\s*$//g; $searchpat =~ s/([^=&]+)=([^=&]+)/\$_->{\U$1\E} =~ \/\Q$2\E\/i/g; $searchpat =~ s/\&/ \&\& /g; $searchpat =~ s/\+/ /g; $searchpat =~ s/\%([\da-z]{2})/pack('H2',$1)/ieg; # OVERRIDING SECURITY if ($searchpat =~ /^(.*)$/) { $searchpat = $1; } else { errout("Invalid pattern '$searchpat'"); } my @result = grep eval $searchpat, @records; print "Status: 200 OK\nContent-Type: text/html; charset=iso-8859-1\n\n"; print < Results of search on NGO database FILE_HEAD print '

', scalar(@result), ' of ', scalar(@records), " match

\n"; my $display = $searchpat; $display =~ s/\$_->{([^}]*)}\s*=~\s*\/([^\/]*)\/i/'$2' in '$1'/g; $display =~ s/\&\&/ AND /g; $display =~ s/(\s*AND\s*)'Search' in 'SUBMIT'//; $display =~ s/'Search' in 'SUBMIT'(\s*AND\s*)?//; print "

SEARCH PATTERNS WERE: $display

\n"; foreach $currentrec (@result) { print "

\n"; foreach (sort { foreach (@preforder) { if ($_ eq $a) { return -1; } if ($_ eq $b) { return 1; } }; return 0;} keys %{$currentrec}) { next if /^SUBMIT$/; s//\>/g; s/\&/\&/g; print "\n"; if ($_ eq "E-MAIL" || $_ eq "EMAIL" || $_ eq "E-MAIL ") { $_ = $currentrec->{$_}; s/^\s+//g; s/
\s*$//; if (!/^$_":(), split /[,;\s]/); } } elsif ($_ eq "WEBSITE" || $_ eq "WEB") { $_ = $currentrec->{$_}; s/^\s+//g; s/
\s*$//; if (!/^$_"; } else { $_ = "$_"; } } } else { $_ = $currentrec->{$_}; s/^\s+//g; } # s/<[^>]*>/ /g; # s//\>/g; s/\&/\&/g; print "\n"; } print "

"; } print "

\n"; print <Disclaimer

FILE_TAIL sub errout { print "Status: 400 denied\nContent-Type: text/plain\n\n"; print "Cannot deal with @_\n"; exit(0); }