36 users online (1 members and 35 guests)  


  Results 1 to 3 of 3

Related

  1. newB question    Forum: CGI Perl Forum
    Replies: 1
  2. hi there , + one question    Forum: AHFB Feedback
    Replies: 1
  3. Stupid Newb Question    Forum: HTML Forum
    Replies: 7
  4. CSS question    Forum: CSS Forum
    Replies: 5
  5. Hi All.... Imma Newb    Forum: Introduce Yourself
    Replies: 2
  1. #1
    rak's Avatar
    New User

    Status
    Offline
    Join Date
    May 2007
    Posts
    2

    Post 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   
    #-###########################################-#

  2. #2
    rak's Avatar
    New User

    Status
    Offline
    Join Date
    May 2007
    Posts
    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>

  3. #3
    xmassey's Avatar
    Senior Member

    Status
    Offline
    Join Date
    Apr 2007
    Posts
    100

    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 trying to place a value into the textbox which was generated from the script then you would use something like $value (where $value = the value you generated).
    If your script ends before finishing, it has nothing to do with this html form
    Last edited by vinyl-junkie; 10-15-2007 at 06:05 AM. Reason: Added code tags



Tags for this Thread