Submit Your Article Forum Rules

Results 1 to 2 of 2

Thread: Looking for Perl Help

  1. #1
    Junior Member
    Join Date
    Apr 2005
    Posts
    21

    Looking for Perl Help

    Hi,

    I have this search engine script that I'd like to edit. I'd love to add to the affiliate part of the script as well as the admin.

    1. Affiliate part of script: I'd like to add to where
    affiliates can earn points for posting my search box on their site and the points added at end of each month.

    2. Affiliate part of script: Option to turn the points in for cash or items: $50 would be 50 points instead of $50. 50 points would equal to $20.00

    Here is the affiliate coding as is:

    #1 = Search
    #2 = Click
    #3 = New Sign-up Referral
    #4 = Deposit
    #5 = Two-tier percentage

    sub afflog
    {
    my ($u, $type, $payamount, $other, $dir) = @_;
    my ($afound) = 0;

    if ($dir .= '') { $dir .= '/' }

    if ($type == 1 && !(-e "$accounts_dir/$u"))
    {
    $info{'USERNAME'} = $u;
    &dotemplate('error_noaffiliate.tpl');
    exit;
    }

    $logip = "$ENV{'REMOTE_ADDR'}";
    $file = "$dir$accounts_dir/$u/logs/aff/$year-$realmonth-$dayofmonth.aff";

    if ($type == 1 || $type == 2)
    {
    if ($settings{'affiliate_unique'})
    {
    open(DATA, $file);
    flock (DATA,$LOCK_SH);
    while ( <DATA> )
    {
    if($_ =~ /^$type&&$logip&&/) { $afound = 1; last; }
    }
    flock (DATA,$LOCK_UN);
    close(DATA);
    }
    }
    if(!$afound)
    {
    &writepayment($file, $type, $logip, $payamount, $other)
    &changebalance($u, $payamount);

    if ($settings{'affiliate_aff_perc'} > 0)
    {
    $payamount = &makefloat($settings{'affiliate_aff_perc'}*$payamo unt/100);
    if ($payamount > 0)
    {
    &readuser($u);
    if ($user{'referrer'} ne '' && -e "$accounts_dir/$user{referrer}")
    {
    $file = "$dir$accounts_dir/".$user{'referrer'}."/logs/aff/$year-$realmonth-$dayofmonth.aff";
    &writepayment($file, 5, $logip, $payamount, $u);
    &changebalance($user{'referrer'}, $payamount);
    }
    }
    }
    }
    }

    sub writepayment
    {
    my($f, $t, $l, $p, $u) = @_;
    open(DATA,">>$f");
    flock(DATA, $LOCK_EX);
    print DATA "$t&&$l&&$p&&$u\n";
    flock(DATA, $LOCK_UN);
    close(DATA);
    }

    1;

    ----------------------------------------------------

    3. Admin. part of script: allow affiliate(which would be me) to either accept or reject affiliates. If accepted the affiliate starts up. If rejected no points are tracked/given.

    4. Admin. part of script: Allow Admin. to receive emails letting them know an advertise or potential affiliate partner have signed up.

    5. Admin part of script: allow admin. to set $$$ to points and set the points options meaning $50 would really be 50 points, which equals $20.00

    Coding for Admin.cgi


    if ($ENV{'SERVER_SOFTWARE'} =~ /microsoft/i)
    {
    $path = $ENV{'PATH_TRANSLATED'};
    $path =~ /^(.*)\\[^\\]*$/;
    $path = $1;
    chdir $path;
    }

    $ssversion = '4.34';

    use CGI;
    use CGI::Carp qw/fatalsToBrowser/;

    require 'include/functions.cgi';

    $cgi = new CGI;

    &loadsettings;
    &loadstrings('general');
    &loadstrings('admin');

    if ($settings{'debug'}) { open(DEBUG, ">$data_dir/debug.dat") }

    $action = $cgi->param('action');
    $sub = $cgi->param('sub');

    &checkpass;

    $action = 'summary' if ($action eq '');

    if ($access eq 'f')
    {
    if ($action eq 'email' && $sub eq 'list') { require 'include/admin_email.cgi' }
    if ($action eq 'misc' && $sub eq 'backup' && $cgi->param('method') == 2 ) { require 'include/admin_misc.cgi' }

    &printhead;
    &printmenu if ($action ne 'goto');

    if ($action eq 'finance') { require 'include/admin_finance.cgi' }
    elsif ($action eq 'email') { require 'include/admin_email.cgi' }
    elsif ($action eq 'misc') { require 'include/admin_misc.cgi' }
    elsif ($action eq 'access') { require 'include/admin_access.cgi' }
    elsif ($action eq 'members') { require 'include/admin_members.cgi' }
    elsif ($action eq 'goto') { &goto }
    elsif ($action eq 'register') { &register }
    elsif ($action eq 'search') { require 'include/admin_search.cgi' }
    elsif ($action eq 'settings') { require 'include/admin_settings.cgi' }
    elsif ($action eq 'templates') { require 'include/admin_templates.cgi' }
    else { require 'include/admin_summary.cgi' }

    &printfoot;
    }
    else
    {
    &printhead;
    &printmenu;
    require 'include/admin_summary.cgi';
    &printfoot;
    }

    exit;

    sub checkpass
    {
    if ($cgi->param('login'))
    {
    $user = $cgi->param('user');
    $pass = $cgi->param('pass');
    }
    elsif ($cgi->cookie('ssadminuser') ne '')
    {
    $user = &Decrypt($cgi->cookie('ssadminuser'),$encryptkey,'asdfhzxcvnmpoi yk');
    $pass = &Decrypt($cgi->cookie('ssadminpass'),$encryptkey,'asdfhzxcvnmpoi yk');
    }

    if ($user eq '' || $pass eq '') { &printlogin('') }

    open(DATA, "$data_dir/admin.data");
    flock(DATA, $LOCK_SH);
    $count = 0;
    $epass = &Encrypt($pass, $adminkey,'asdfhzxcvnmpoiyk');
    my($ruser) = &regescape($user);
    my($rpass) = &regescape($epass);
    while ( <DATA> )
    {
    $count++;
    chomp;
    if ($_ =~ /^$ruser&&$rpass&&(.{1})&&(.*)/i )
    {
    $access = $1;
    $ip = $2;
    $found = 1;
    last;
    }
    }
    flock(DATA, $LOCK_UN);
    close(DATA);

    if ($count == 0) { $access = 'f' }
    elsif (!$found) { &printlogin($string{'invalid_login'}) }

    if ($ip ne '')
    {
    ($ip1, $ip2, $ip3, $ip4) = split('\.', $ENV{'REMOTE_ADDR'}, 4);
    if ($ip ne '*' &&
    $ip !~ /^$ip1\.\*/ &&
    $ip !~ /^$ip1\.$ip2\.\*/ &&
    $ip !~ /^$ip1\.$ip2\.$ip3\.\*/ &&
    $ip ne $ENV{'REMOTE_ADDR'} ) { &printlogin($string{'invalid_ip'}) }
    }

    push @cookies, $cgi->cookie(-name=>'ssadminuser', -value=>&Encrypt($user,$encryptkey,'asdfhzxcvnmpoiy k'));
    push @cookies, $cgi->cookie(-name=>'ssadminpass', -value=>&Encrypt($pass,$encryptkey,'asdfhzxcvnmpoiy k'));
    }

    sub startcell
    {
    print <<EOF;
    <tr bgcolor="#B8B8B8">
    <td>


    </p>
    EOF
    if ($#titles < 0) { return }
    print '

    <table border=0 cellpadding=1 cellspacing=0>';
    for $i (0..$#titles)
    {
    $what = $what[$i];
    $thing = '-';
    if ($what == 0) { $thing = '' }
    print "<tr><td nowrap valign=\"top\"> $thing</td><td valign=\"top\">";
    if ($what == 1)
    {
    if ($links[$i] eq $sub) { print "$titles[$i]" }
    else { print "<a href=\"admin.cgi?action=$action&sub=$links[$i]\">$titles[$i]</a>" }
    }
    elsif ($what == 2) { print "$titles[$i]" }
    elsif ($what == 3)
    {
    if ($links[$i] ne '') { print "<a href=\"$links[$i]\">$titles[$i]</a>" }
    else { print "$titles[$i]" }
    }
    elsif ($what == 4)
    {
    ($link) = split('\|', $links[$i], 2);
    if ($links[$i] =~ /$sub/ && $sub ne '' ) { print "$titles[$i]" }
    else { print "<a href=\"admin.cgi?action=$action&sub=$link\">$title s[$i]</a>" }
    }
    if ($descrips[$i] ne '') { print " - $descrips[$i]" }
    print "</td></tr>\n";
    }
    print '</table></p>';
    }

    sub printmenu
    {
    my @links = ('summary', 'members', 'finance','settings', 'templates', 'search',
    'access', 'email', 'misc');
    my @accesslevel = (1, 0, 0, 0, 0, 0, 0, 0, 0);
    my $color = 255;

    print "<table width=\"100%\" border=0 cellpadding=5 cellspacing=0><tr>\n";
    for $i (0..$#links)
    {
    $bgcolor = sprintf("#4040%x", $color);

    if (($accesslevel[$i] == 0) && ($access eq 'l'))
    {
    print "<td align=\"center\" bgcolor=\"$bgcolor\" class=\"top\">".$string{"main_menu_$links[$i]"}."</td>\n";
    }
    else
    {
    if ($action eq $links[$i])
    {
    print "<td align=\"center\" bgcolor=\"$bgcolor\" class=\"current\">".$string{"main_menu_$links[$i]"}."</td>\n";
    }
    else
    {
    print "<td align=\"center\" bgcolor=\"$bgcolor\"><a href=\"admin.cgi?action=$links[$i]\" class=\"top\">".$string{"main_menu_$links[$i]"}."</a></td>\n";
    }
    }
    $color -= 16;
    }
    print "</tr></table></td></tr>\n";
    }

    sub printlogin
    {
    my ($msg) = @_;

    &printhead(1, $msg);

    print <<EOF;

    <form method="post" action="admin.cgi">
    <table border=1 cellpadding=6 cellspacing=1 bgcolor="#FFFFFF" width="100%">
    <tr bgcolor="#404090"><td class="top" align="center">$string{'login_title'}</td></tr>

    <tr><td bgcolor="#808080">
    <table border=0 cellpadding=0 cellspacing=2 width="100%">
    <tr bgcolor="#808080"><td>$string{'username'}:</td><td><input type="text" name="user" value="$user" size=15></td></tr>
    <tr bgcolor="#808080"><td>$string{'password'}:</td><td><input type="password" name="pass" value="$pass" size=15></td></tr>
    </table>
    </td></tr>

    <tr bgcolor="#808080"><td align="center"><input type="submit" value="$string{'login_submit'}"></td></tr>
    </table>

    <input type="hidden" name="login" value="1">
    </form>
    EOF
    &printfoot;
    exit;
    }

    sub printhead
    {
    my ($val, $msg) = @_;
    if ($val) { $width=200 }
    else { $width = 750 }

    if ($msg ne '') { $msg = "<tr><td class=\"mainerror\" align=\"center\">$msg</td></tr><tr><td></td></tr>" }

    print $cgi->header(-cookie=>[@cookies]);
    print <<EOF;
    <html>
    <head>
    <script language="JavaScript">
    <!--
    function CheckAll() {
    var i, e;
    for (i=0;i<document.theForm.elements.length;i++) {
    e = document.theForm.elements[i];
    if ((e.name != 'all') && (e.type=='checkbox')) {
    e.checked = document.theForm.all.checked;
    }
    }
    }

    function submitonce(theform){
    //if IE 4+ or NS 6+
    if (document.all||document.getElementById) {
    //screen thru every element in the form, and hunt down "submit" and "reset"
    for (i=0;i<theform.length;i++){
    var tempobj=theform.elements[i]
    if(tempobj.type.toLowerCase()=="submit"||tempobj.t ype.toLowerCase()=="reset")
    //disable em
    tempobj.disabled=true
    }
    }
    }
    // -->
    </script>
    <style type="text/css">
    <!--
    body, td { font-family: Arial, sans-serif; font-size: 12px }
    .balance { color: #90D090; font-weight: bold }
    .error { color: #FFFFFF; font-weight: bold }
    .mainerror { color: #0000FF; font-weight: bold }
    .warning { color: #5020FF; font-weight: bold }
    .top { color: #FFFFFF; font-weight: bold }
    a { color: #2020C0; text-decoration: none }
    a:hover { text-decoration: underline }
    a.top { color: #FFFFFF; font-weight: bold; text-decoration: none }
    a.top:hover { text-decoration: underline }
    .small { font-size: 10px }
    .current { color: #F0C0C0; font-weight: bold}
    -->
    </style>
    <title>$string{'main_title'}</title>
    </head>
    <body bgcolor="#D0D0FF">
    <table width=800 cellpadding=0 cellspacing=0 border=0>
    <tr><td>$string{'main_title'} - $settings{'sitetitle'}</td></tr>
    <tr><td></td></tr>
    <tr><td></td></tr>
    $msg
    <tr><td align="center">

    <table width=$width border=1 cellpadding=0 cellspacing=1 bgcolor="#FFFFFF">
    <tr><td>

    EOF
    }

    sub printfoot
    {
    print <<EOF;

    </td></tr>
    </table>

    </td></tr>
    <tr><td></td></tr>
    <tr><td align="center" class="small">$string{'script_by'}</td></tr>
    </table>
    </body>
    </html>
    EOF
    }

    sub goto
    {
    $goto = $cgi->param('goto');
    print <<EOF;
    <META HTTP-EQUIV=REFRESH CONTENT="1; URL=$goto">
    <center>

    Redirecting you to the desired page...</p>


    Continue to $goto</p></center>
    EOF
    }

    sub register
    {
    if ($settings{'payment_dir'} eq '' || $settings{'payment_url'} eq '')
    {
    $message = $string{'save_payment_info'};
    require 'include/admin_settings.cgi';
    return;
    }

    eval 'require "$settings{payment_dir}/include.cgi"';
    if ($settings{'debug'}) { print DEBUG "require \"$settings{payment_dir}/include.cgi\"\n" }
    if ($@ ne '')
    {
    $message = $string{'register_bad_dir'};
    $message =~ s/<<ERROR>>/
    $@/;
    require 'include/admin_settings.cgi';
    return;
    }
    $payment_id = $settings{'payment_id'};
    if ($payment_id !~ /^SS/) { $payment_id = 'SS40' }
    &payment_init($settings{'payment_dir'}, $payment_id, $settings{'payment_url'});
    $result = &payment_register($payment_id, "Smart Search v$ssversion", $settings{'server_path'}, $settings{'server_path'}.'/include/payment.cgi');
    $message = $string{"register_$result"};
    $settings{'payment_id'} = $payment_id;
    &savesettings;
    require 'include/admin_settings.cgi';
    }


    Note: If anyone is willing to help I could add your site URL to my forums.

  2. #2
    Guest

    comments?

    Fem,
    Putting some more comments in the code may help readers understand it more quickly. Some might be put off by the volume of code here and in-code documentation would probably make it more digestible.

Similar Threads

  1. PERL pass "Perl" crash
    By TrafficProducer in forum Web Programming Discussion Forum
    Replies: 0
    Last Post: 09-02-2007, 02:07 PM
  2. Perl, CGI and SSI
    By dak888 in forum Web Programming Discussion Forum
    Replies: 2
    Last Post: 02-27-2007, 11:16 AM
  3. Need help with alt tags in Perl
    By armadacomputers in forum Web Programming Discussion Forum
    Replies: 8
    Last Post: 08-22-2005, 04:05 AM
  4. perl
    By pagetta in forum Web Programming Discussion Forum
    Replies: 2
    Last Post: 02-16-2005, 05:26 PM
  5. Can't find Perl!!
    By mikmik in forum Web Programming Discussion Forum
    Replies: 8
    Last Post: 11-21-2003, 04:07 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •