cl.cgi

点出系统1,打开cl.cgi,修改$myurl为你自己的实际使用路径!(也可以不修改) 2,上传到任意支持CGI的目录,设置cl.cgi属性为755 3,daten目录以及里面的所有文件属性设置为

#!/usr/bin/perl
##########################################################################
$myurl = 'http://host8.org/cgi-bin/cl/cl.cgi'; #请修改本处为您的访问路径 #
##########################################################################
#良好的代码结构是一个程序员的生存之本!
#以下为程序主体部分,不需要任何修改,请不要随意修改
use CGI::Carp qw(fatalsToBrowser);
use CGI qw/:standard/;
use Fcntl qw(:DEFAULT :flock);
my(%tmpl,$datenum);
$tmpl{version} = '1.0'; #程序版本号
my $q = new CGI;
my %form = $q->Vars;
my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
sysopen(DATUM,"daten/datum.dat",O_RDWR) || &fehlerausgabe($Fehler_1);
flock(DATUM,LOCK_EX);
my $date = <DATUM>;
	unless ($date == $mday) {
		$datenum = 1;
		truncate(DATUM,0);
		seek(DATUM,0,0);
		print DATUM $mday;
	}
close(DATUM);
if ($datenum) {
	sysopen(TOTAL,"daten/total.dat",O_RDWR) || &fehlerausgabe($Fehler_2);
	flock(TOTAL,LOCK_EX);
	my($hits_today,$hits_1,$hits_2,$hits_3,$hits_highest,$hits_total,$hits_days) = split(/\|/,<TOTAL>);
	if ($hits_today > $hits_highest) { 
		$hits_highest = $hits_today; 
	}
	$hits_days++;
	truncate(TOTAL,0);
	seek(TOTAL,0,0);
	print TOTAL join('|',"0",$hits_today,$hits_1,$hits_2,$hits_highest,$hits_total,$hits_days);
	close(TOTAL);
}
open(CLM,"daten/cl.dat") || &fehlerausgabe($Fehler_3);
my @db = <CLM>;
close(CLM);
if ($form{dl}) { &dl; }            
	elsif ($form{num}) { &num; }       
	elsif ($form{numall}) { &numall; } 
	else { &stats; }                   
sub dl {
	my $done2 = 0;
	&checkid($form{dl});
	sysopen(CLM,"daten/cl.dat",O_WRONLY|O_TRUNC) || &fehlerausgabe($Fehler_3);
	flock(CLM,LOCK_EX);
	foreach (@db) {
		chomp;
		my ($id,$url2,$hits) = split(/\|/);
		if ($url2 eq $form{dl}) {
			$hits++;
			print CLM "$id|$url2|$hits\n";
			$done2 = 1;
		}
		else { 
			print CLM "$_\n"; 
		}
	}
	close(CLM);
	unless ($done2) {
		my @db = sort { $b <=> $a }@db;
		my($num,$url2,$hits) = split(/\|/,$db[0]);
		$num++;
		sysopen(CLM,"daten/cl.dat",O_WRONLY|O_APPEND) || &fehlerausgabe($Fehler_3);
		flock(CLM,LOCK_EX);
		print CLM "$num|$form{dl}|1\n";
		close(CLM);
	}
	sysopen(TOTAL,"daten/total.dat",O_RDWR) || &fehlerausgabe($Fehler_2);
	flock(TOTAL,LOCK_EX);
	my($hits_today,$hits_1,$hits_2,$hits_3,$hits_highest,$hits_total,$hits_days) = split(/\|/,<TOTAL>);
	$hits_today++;
	$hits_total++;
	truncate(TOTAL,0);
	seek(TOTAL,0,0);
	print TOTAL join('|',$hits_today,$hits_1,$hits_2,$hits_3,$hits_highest,$hits_total,$hits_days);
	close(TOTAL);
	print "Location: $form{dl}\n\n";
}

sub num {
	my @urls = split(/\|\|\|/,$form{num});
	my $num = 0;
	foreach my $line(@urls) {
		&checkid($line);
		foreach (@db) {
			chomp;
			my ($id,$url,$hits) = split(/\|/);
				if ($line eq $url) { 
					$num+=$hits; last; 
				}
		}
	}
	print "Content-type: text/html\n\n$num";
}

sub numall {
	my $num = 0;
	foreach (@db) {
		chomp;
		my($id,$url,$hits) = split(/\|/);
		$num+=$hits;
	}
	print "Content-type: text/html\n\n$num";
}

sub stats {
	open(TOTAL,"daten/total.dat") || &fehlerausgabe($Fehler_2);
	my($hits_today,$hits_1,$hits_2,$hits_3,$hits_highest,$hits_total,$hits_days) = split(/\|/,<TOTAL>);
	close(TOTAL);
	$tmpl{hits_total} = $hits_total;
	my $g_avg = "平均点击|" . $hits_total / $hits_days;
	my $g_today = "今天点击|$hits_today";
	my $g_1 = "昨天点击|$hits_1";
	my $g_highest = "最高点击|$hits_highest";
	$tmpl{totalgraph} = &graph($g_avg,$g_today,$g_1,$g_highest); 
	foreach my $line(@db) {
		chomp;
		my($id,$url,$hits) = split(/\|/,$line);
		$line = join('|',$hits,$url,$id);
	}
	@db = sort { $b <=> $a }@db;
	foreach (@db) {
		my($hits,$url,$id) = split(/\|/);
		$tmpl{individual} .= qq~<tr><td class="cell">$id</td><td class="cell">$url</td><td class="cell">$myurl?dl=$url</td><td align="right" class="cell"><font color=red>$hits</font></td></tr>~;
	}
	&template;
}

sub checkid { #检测连接地址是不是以http://开头
	my $done = 0;
	foreach my $line(@_) {
		unless ($line =~ "http:") {
			foreach (@db) {
				chomp;
				my($id,$url,$hits) = split(/\|/);
				if ($id == $line) {
					$line = $url;
					$done = 1;
					last;
				}
			}
			unless ($done) { &error("请检查您附加的连接地址,确认是http://开头"); }
		}
	}
}

sub error { #错误
	print "Content-type: text/html\n\n$_[0]\n";
	exit;
}

sub graph {
	my($gtext,$min_data,$max_data,$dots,$dotstring);
	my $dot = "|";
	my $tag = 5;
	my $scale = 1;
	my $columns = 80;
	my @data = @_;
	foreach (@data) {
		my($key,$value) = split(/\|/);
		if ($min_data > $value) { $min_data = $value; }
		if (length($key) > $tag) { $tag = length($key); }
		if ($value > $max_data) { $max_data = $value; }
	}
	if (!defined($max_data)) { $max_data = 0; }
	my $data_length = length($max_data);
	my $barsize = $columns - ($tag + $data_length + 4);
	if ($max_data) { $scale = $barsize / ($max_data); }
	foreach (@data) {
		my($key,$value) = split(/\|/);
		$dots = int(($value) * $scale);
		$dotstring = ${dot}x$dots;
		$gtext .= "<tr><td class=\"cell\"><b>" . sprintf("%${tag}s</b></td><td class=\"cell\">%${data_length}d</td><td class=\"cell\">%s\n", $key, $value, $dotstring) . "</td></tr>";
	}
	return $gtext;
}

sub strip {
	$_[0] =~ s/</\&lt\;/g;
	$_[0] =~ s/>/\&gt\;/g;
	$_[0] =~ s/\|/\&\#124\;/g;
	$_[0] =~ s/\"/\&quot\;/g;
	$_[0] =~ s/\n/<br \/>/g;
	$_[0] =~ s/\cM//g;
	return $_[0];
}

sub template {
	open(TEMPLATE,"daten/template.html") || &fehlerausgabe($Fehler_4);
	flock(TEMPLATE,LOCK_EX);
	my $template = join('',<TEMPLATE>);
	close(TEMPLATE);
	$tmpl{ps} = '说明:下载本程序后,打开主文件,修改<font color=red>$myurl</font>为你自己的实际访问路径<br>然后:请直接使用 <font color=#0000CD>$myurl</font><font color=red>?dl=URL</font> 方式访问,程序会自动加入相关统计信息<br /><br />例如:<a href=http://www.wikisky.net target=_blank>www.wikisky.net</a> 的访问统计地址是 <a href='.$myurl.'?dl=http://www.wikisky.net target=_blank>'.$myurl.'?dl=http://www.wikisky.net</a><br />例如:<a href=http://www.google.com target=_blank>www.google.com</a> 的访问统计地址是 <a href='.$myurl.'?dl=http://www.google.com target=_blank>'.$myurl.'?dl=http://www.google.com</a><br><br>备注:版权信息请不要删除,否则程序无法使用的说....<br><br>';
	$tmpl{copyright} = "程序名称 <a href=\"http://www.wikisky.net/\" target=\"_blank\">点出统计 ".$tmpl{version}."</a> | 程序整理 <a href=\"http://www.wikisky.net/\" target=\"_blank\">PPOPCN</a> | 主页地址 <a href=\"http://www.wikisky.net/\" target=\"_blank\">WikiSky.Net</a>";
	print "Content-type: text/html\n\n";
	if ($template =~ /<\$copyright>/) {
		$template =~ s/<\$(.+?)>/$tmpl{$1}/ig;
		print $template;
	}
	else { 
		print "对不起,由于您删除了版权信息,本程序已经失效,请尊重作者劳动,保留版权信息!.\n"; 
	}
}
sub fehlerausgabe {
	$Fehler_1 = "datum.dat文件不存在或文件不可写,请检查相关文件.";
	$Fehler_2 = "total.dat文件不存在或文件不可写,请检查相关文件.";
	$Fehler_3 = "cl.dat文件不存在或文件不可写,请检查相关文件.";
	$Fehler_4 = "模板文件不存在,请检查相关目录.";
	($fehler) = @_;
	print "Content-type: text/html\n\n";
	print qq~
		<font face="Verdana, Arial" size="2" color="#ff0000"><b>发生错误!!</b><br>$fehler<br></font>
	~;
	exit;
}