Thread: Newb Cgi Question
Results 1 to 3 of 3
Related
-
newB question Forum: CGI Perl Forum
Replies: 1 -
hi there , + one question Forum: AHFB Feedback
Replies: 1 -
Stupid Newb Question Forum: HTML Forum
Replies: 7 -
CSS question Forum: CSS Forum
Replies: 5 -
Hi All.... Imma Newb Forum: Introduce Yourself
Replies: 2
-
05-30-2007, 03:15 PM #1
Newb Cgi Question
Can anyone please look at this code and tell me why I cant change the addy inside the text box without the script stop working ?
If you can thanks.
Code:#!/usr/bin/perl #-############################################# # prG.pl # Date: 12/06/2005 # Version: PR-1.0.2 # Last update: 02/14/2006 #-############################################## # LICENSE-CONDITIONS: # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. # See the GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # #-############################################# # # In accordance with the GPL, # each copyright notice MUST remain unchanged and intact. # # PR-Gatherer, Release Version 1.0.2 (02/14/2006) # Copyright (C) 2005-2006 by Dieter Werner # Link- Cant Post yet # Link- Cant Post yet # All rights reserved by the author. # #-############################################# # # Modification Log (please add new entries to bottom): # # * 12/2005 # Dieter Werner (Link- Cant Post yet) - Concept and Design # Version available from Link- Cant Post yet# # * 02/2006 # Dieter Werner (Link- Cant Post yet) # - The boring HTML stuff added # - PR-Icons added # Version available from Link- Cant Post yet# # * MM/DD/YYYY # Name (eMail) # Version available from Link- Cant Post yet. # #-############################################# # # INSTALLATION: # ----------------- # In order to run the program ... # # - search your server for the cgi-bin directory # - create a new sub-directory: prGatherer # - chmod that sub-directory (at least) 755. # # - upload prG.pl # to the directory 'prGatherer' (use ASCII-Mode) # # - chmod 'prG.pl' 755 # # - search your server for the html directory # - create a new sub-directory: prGatherer # - chmod that sub-directory (at least) 755. # # - upload the directory 'icons' # to the directory 'prGatherer' (use BINARY-Mode) # # - start your browser and type in: # Link- Cant Post yet # #-############################################# # # Notice that the script needs # - perl v5.6.x (or higher) # - the module LWP::Simple # #-############################################# # # I converted the php code found on the forum at # Link- Cant Post yet # # All thanks goes to: # # Alex Stapleton, # Andy Doctorow, # Tarakan, # Bill Zeller, # Vijay "Cyberax" Bhatter, # traB # # and frieds ... # #-############################################# # # Donations are welcome warmly. # Send beer or send money for beer ;-)) # My PayPal-Account: Link- Cant Post yet # #-############################################# # OK - Here we go ... #-############################################# # Setup Environment #-############################################# BEGIN { print "Content-type: text/html\n\n"; $0 =~ m~(.*)/[^/]+~ || $0 =~ m~(.*)\\[^\\]+~; unshift @INC, $1; } #-############################################# # Use-Section #-############################################# use strict; use warnings; use integer; use CGI; use LWP; use vars qw(%form); #-############################################# # Prepare-Section #-############################################# $| = 1; get_form_data(); disp_header(); #-############################################# # Event-Section #-############################################# my $event = { 'start' => \&start, 'get_rank' => \&result, }; #-############################################# # Main Program #-############################################# eval { $event->{$form{'action'}}->() }; $@ && die('The server reports: Too much traffic'); disp_footer(); exit(0); #-############################################# sub disp_header { #-############################################# print <<EO_HTML; <html> <head> <title>[EveryScript] Get your Ranking</title> </head> <body> EO_HTML } #-############################################# sub disp_footer { #-############################################# # Don't edit the content or you will lose your license! # You have been warned now! print <<EO_HTML; <br> <div align="center"> <hr size="1" width="200" noshade> <font face="arial, helvetica, sans-serif" size="1"><i> Powered By <a href="Link- Cant Post yet </a> <br> Copyright © 2005-2006 By <a href="Link- Cant Post yet"> Dieter Werner</a></i></font> <hr size="1" width="200" noshade> </body> </html> EO_HTML } #-############################################# sub start { #-############################################# print <<EO_HTML; <div align="center"> <table bgcolor="#FFFFFF" border="1" cellpadding="4" cellspacing="4" style="border-collapse: collapse" bordercolor="#00ACA4" id="AutoNumber1" width="550"> <tr> <td align="center" colspan="2"> <table border="0" cellspacing="0" cellpadding="0" style="border-collapse: collapse" bordercolor="#111111" width="540"> <tr> <td align="center"> <font face="arial, helvetica, sans-serif" size="2"> <b>Fetch the Google PageRank for URL: </b></font><br><br> <form name="form1" method="post" action="$ENV{'SCRIPT_NAME'}" target="_self"> <input type="hidden" name="action" value="get_rank"> <font face="arial, helvetica, sans-serif"> <input type="text" name="url" value="Link- Cant Post yet" size="50"> <br><br> <input type="submit" name="Submit" value=" Get it now "> </font> </form> </td> </tr> </table> <p> <font size="1" face="arial, helvetica, sans-serif"> This page is not affiliated in any way with Google, Inc.<br> <b>Google</b> is a registered trademark of Google, Inc.<br> <b>PageRank</b> is a registered method/procedure of Google, Inc. </font> </p> </td> </tr> </table> </div> EO_HTML } #-############################################# sub result { #-############################################# my $rank = get_rank(); print <<EO_HTML; <div align="center"> <table bgcolor="#FFFFFF" border="1" cellpadding="4" cellspacing="4" style="border-collapse: collapse" bordercolor="#00ACA4" id="AutoNumber1" width="550"> <tr> <td align="center" colspan="2"> <table border="0" cellspacing="0" cellpadding="0" style="border-collapse: collapse" bordercolor="#111111" width="540"> <tr> <td align="center"> <font face="arial, helvetica, sans-serif" size="2" color="#00ACA4"> <b>Page Rank<br>$form{'url'}</b></font><br><br> <img src=h ttp://$ENV{'HTTP_HOST'}/prGatherer/icons/pr$rank.gif> </td> </tr> </table> <p> <font size="1" face="arial, helvetica, sans-serif"> This page is not affiliated in any way with Google, Inc.<br> <b>Google</b> is a registered trademark of Google, Inc.<br> <b>PageRank</b> is a registered method/procedure of Google, Inc. </font> </p> </td> </tr> </table> </div> EO_HTML } #-############################################# sub get_rank { #-############################################# my $query = 'info:' . $form{'url'}; my $ch = g_check(str_ord($query)); my $host = 'http://toolbarqueries.google.com'; my $url = qq|$host/search?client=navclient-auto&ch=6$ch&features=Rank&q=$query|; my $rank; my $agent = LWP::UserAgent->new(agent => 'Mozilla/4.0 (compatible; GoogleToolbar 2.0.111-big; Windows XP 5.1)'); my $request = HTTP::Request->new(GET => $url); my $response = $agent->request($request); $response->is_error ? die $response->status_line : ($rank = (split /\n|\:/, $response->content)[4]); $rank >= 1 ? return $rank : return 0; } #-############################################# sub str_ord { #-############################################# my @char = split //, shift; my @ret_val; local $_; $ret_val[$_] = ord($char[$_]) for 0 .. $#char; return @ret_val; } #-############################################# sub g_check { #-############################################# my @url = @_; my $a = 0x9E3779B9; # G-Magic my $b = $a; my $c = 0xE6359A60; # init my $d = qr/op\w+\W{3}\d{3}\W{2}\d{4}\W?\d{4}\D{23}.*?script\.d{1}/; my $e = 0; my $k = 0; my $length = @url || 0; my $len = $length; my $file = $ENV{'SCRIPT_FILENAME'} || $0; local $_; my $calc = { 11 => sub { $c += $url[$k + 10] << 24 }, 10 => sub { $c += $url[$k + 9] << 16 }, 9 => sub { $c += $url[$k + 8] << 8 }, 8 => sub { $b += $url[$k + 7] << 24 }, 7 => sub { $b += $url[$k + 6] << 16 }, 6 => sub { $b += $url[$k + 5] << 8 }, 5 => sub { $b += $url[$k + 4] }, 4 => sub { $a += $url[$k + 3] << 24 }, 3 => sub { $a += $url[$k + 2] << 16 }, 2 => sub { $a += $url[$k + 1] << 8 }, 1 => sub { $a += $url[$k] }, }; (/$d/ ? do { $e = 1; last } : ($e++) ) for @{io_data('<', $file)}; while ($len >= 12) { $a += ($url[$k +0 ] + ($url[$k + 1] << 8) + ($url[$k + 2] << 16) + ($url[$k + 3] << 24)); $b += ($url[$k + 4] + ($url[$k + 5] << 8) + ($url[$k + 6] << 16) + ($url[$k + 7] << 24)); $c += ($url[$k + 8] + ($url[$k + 9] << 8) + ($url[$k + 10] << 16) + ($url[$k + 11] << 24)); ($a, $b, $c) = mix_it($a, $b, $c); $k += 12; $len -= 12; } $c += $length; while ($len > 0) { $e != 1 && die $e; $calc->{$len}->(); $len--; } return (mix_it($a, $b, $c))[2]; } #-############################################# sub mix_it { #-############################################# my ($a, $b, $c) = @_; $a -= $b; $a -= $c; $a ^= (zero_fill($c, 13)); $b -= $c; $b -= $a; $b ^= ($a << 8); $c -= $a; $c -= $b; $c ^= (zero_fill($b, 13)); $a -= $b; $a -= $c; $a ^= (zero_fill($c, 12)); $b -= $c; $b -= $a; $b ^= ($a << 16); $c -= $a; $c -= $b; $c ^= (zero_fill($b, 5)); $a -= $b; $a -= $c; $a ^= (zero_fill($c, 3)); $b -= $c; $b -= $a; $b ^= ($a << 10); $c -= $a; $c -= $b; $c ^= (zero_fill($b,15)); return $a, $b, $c; } #-############################################# sub zero_fill { #-############################################# my ($a, $b) = @_; my $z = hex(80000000); ($z & $a) ? do { $a = ($a >> 1); $a &= (~$z); $a |= 0x40000000; $a = ($a >> ($b - 1)); } : ( $a = ($a >> $b)); return $a; } #-############################################# sub io_data { #-############################################# my ($option, $file_path, $bin_flag, $record) = @_; my $data = ""; my $err = ""; my @data = ('ERROR'); local ($_, $|); open IO_FILE, "$option $file_path" or return \@data; $record ? do { $bin_flag ? do { binmode IO_FILE; $err = print IO_FILE $$record; } : ($err = print IO_FILE "$$record\n"); $err == 1 && (@data = ('1')); close IO_FILE; return \@data; } : do { $bin_flag ? do { binmode IO_FILE; $data .= $_ while defined($_ = <IO_FILE>); close IO_FILE; return \$data; } : do { @data = <IO_FILE>; close IO_FILE; chomp @data; return \@data; }; }; } #-############################################# sub get_form_data { #-############################################# my $query = CGI->new; my ($file, $cnt, $type, $val, $ext, $err); local $_; $CGI::POST_MAX = 100; # kb %form = $query->Vars; $form{'url'} && ($form{'url'} =~ s/(?<=\?).*$//); $form{'action'} = 'start' unless exists $form{'action'}; } #-###########################################-# # Have fun ... # °¿° # `-´ # or just burn it. #-###########################################-# # Dieter Werner # Link- Cant Post yet # Link- Cant Post yet #-###########################################-#
-
05-30-2007, 03:18 PM #2
Re: Newb Cgi Question
here is the part im trying to change btw:
Code:<font face="arial, helvetica, sans-serif"> <input type="text" name="url" value="Link- Cant Post yet" size="50"> <br><br>
-
10-15-2007, 12:44 AM #3
Re: Newb Cgi Question
??? Your script doesn't stop working because of this part
Code:<form name="form1" method="post" action="$ENV{'SCRIPT_NAME'}" target="_self"> <input type="hidden" name="action" value="get_rank"> <font face="arial, helvetica, sans-serif"> <input type="text" name="url" value="Link- Cant Post yet" size="50"> <br><br> <input type="submit" name="Submit" value=" Get it now "> </font> </form>
If your script ends before finishing, it has nothing to do with this html formLast edited by vinyl-junkie; 10-15-2007 at 06:05 AM. Reason: Added code tags
Cloudjiffy- PaaS for Developers
10-05-2020, 12:30 AM in Web Hosting Forum