|
If you are interested in a targeted and cost-effective way to promote your brand, product or sale on DealsforDivas.com please contact:
advertising@dealsfordivas.com
Opportunities include:
» Newsletter
» Dedicated Emails
» Ad Banners and Buttons
|
|
#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);
##########################################################
# CGInews Xtra 12/April/2004
##########################################################
my $script_name = 'http://www.dealsfordivas.com/cgi/adds.pl';
my $databasefile = "/home/content/N/i/n/NinaSutton/html/cgi/adds.txt";
my $image_dir = "/home/content/N/i/n/NinaSutton/html/templates/adds_images";
my $image_url = "http://www.dealsfordivas.com/templates/adds_images";
my $records_per_page = 500;
my $html_template = "/home/content/N/i/n/NinaSutton/html/templates/adds_headline.htm";
my $record_template = "/home/content/N/i/n/NinaSutton/html/templates/adds_details.htm";
my $select_image = 0;
my $add_fields = 0;
my $hspace = 0;
my $vspace = 0;
my $Username = '';
my $Password = '';
my $not_found = '';
my $news_up = 0;
##########################################################
my $ID_autoincrement_name = "ID"; # autoincrement id-key
my @DateFields =('DATE', 'date'); # date fileds, describe for sort function
##########################################################
# Page Selector
my $textPrevious = "";
my $textNext = "Next";
my $pageSelectorRange = 10;
my $records_per_page = 500;
##########################################################
# Scrolling News Headlines
my $Number_of_headlines_to_scroll = 5;
my $speed = 4;
my $bgcolor = "#eeeeee";
##########################################################
# News letter
my $Number_of_news = 10;
my $head_news_separator = "
";
my $news_news_separator = "
";
##########################################################
# EZscripting.co.uk © 1999 - 2004 Copyright Darren Deans
# The scripts are available for private and commercial use.
# You can use the scripts in any website you build.
# It is prohibited to sell the scripts in any format to anybody.
# The scripts may only be distributed by EZscripting.co.uk
# The redistribution of modified versions of the scripts is prohibited.
# EZscripting.co.uk accepts no responsibility or liability
# whatsoever for any damages however caused when using our services or scripts.
# By downloading and using this script you agree to the terms and conditions.
##########################################################
use CGI qw/:standard/;
$FORM{mode}=param('mode');
$FORM{record}=param('record');
$FORM{login}=param('login');
$FORM{password}=param('password');
$FORM{action}=param('action');
$FORM{new_field}=param('new_name');
$FORM{action}="default" if !$FORM{action};
$FORM{headlines} = param('headlines');
$FORM{order_by} = param('order_by');
$FORM{order} = param('order');
$FORM{display} = param('display');
$page=param('page')+1;
$default_mode=1 if param('mode') eq 'shtml';
$default_mode=2 if param('mode') eq 'newsletter';
$default_mode=3 if param('mode') eq 'scrollingnews';
if($Username && $FORM{mode} eq 'admin'){
%COOKIES = get_cookie('Manager');
if($FORM{login}){
if($FORM{password} eq $Password && $FORM{login} eq $Username){
print "Set-Cookie: Manager=login&$FORM{login}&pass&$FORM{password}; path=/\n";
print "Location: $script_name?mode=admin\n\n";
exit;
}
else{print "Content-type: text/html\n\n"; error("Incorrect account!");}
}
elsif(!$COOKIES{login}){ promt();}
elsif($COOKIES{pass} ne $Password or $COOKIES{login} ne $Username){ promt();}
}
if($FORM{action} eq 'logout'){
print "Set-Cookie: Manager=login&pass&; path=/\n";
print "Location: $script_name\n\n";
}
print "Content-type: text/html\n\n";
create_db() unless -f $databasefile;
my $txt;
%SUB = (
default=> \&default,
main => \&main,
add => \&add,
save => \&save,
logout => \&logout,
delete => \&delete,
update => \&update,
view => \&view,
show => \&show,
feature => \&feature,
add_field => \&add_field
);
$SUB{$FORM{action}}->();
html_text($txt);
exit;
####################################################################################################################
sub read_file{
open(F, $_[0]) || error("Can't open file $_[0]!");
my @data = ;
close F;
return @data;
}
sub read_base{
my @content;
my @data = read_file("$databasefile");
for(@DateFields){$DateFields{$_}=1;}
chomp $data[0];
@field_name=split('\|',$data[0]);
my $p=0;
$show_position = -1;
$keyPosition = -1;
foreach(@field_name){
$show_position=$p if $_ eq 'show';
$keyPosition = $p if $_ eq $ID_autoincrement_name;
$p++;
}
error("Can't find key in db-file") if $keyPosition==-1;
error('Bad database file') if @field_name<1;
$word = param('search');
my @keys;
$method = param('method');
@fields = param('field');
foreach $field (@field_name){
$position{$field}=-1;
$p=0;
foreach(@field_name){if($_ eq $field){$position{$field}=$p; last;}$p++;}
}
for(@fields){error("Can't find $field-position in db-file") if $position{$_}<0;}
for (@field_name){
$searchByField{$_} = param($_) if param($_);
}
$exPression = param('exPression');
$value = param('value');
error("Can use exPression only with search in ONE field!") if ($exPression or $value) and @fields>1;
if($word=~m/\A"(.*)"\Z/){$keys[0]=$1;}
elsif(!$action and ($method eq "perfect" or $method eq "exact")){$keys[0]=$word;}
else{@keys= split(" ", $word);}
my $b =0;
$Total =0;
$Found =0;
for(1..@data-1){
chomp $data[$_];
@line=split('\|',$data[$_]);
my $a=0;
if($_[0] == 1){
if($line[$show_position] eq 'Yes'){
if($exPression and $value){
error("Please select field") unless $fields[0];
$field=$fields[0];
if ($DateFields{$field}){
$tmpLine= modify_date($line[$position{$field}]);
$values = modify_date($value);
}
else{$values = $value;}
my $found=0;
if ($exPression eq ">="){if ($tmpLine >= $values){ $found++; }}
elsif ($exPression eq "<"){if ($tmpLine < $values){ $found++; }}
elsif ($exPression eq ">"){if ($tmpLine > $values){ $found++; }}
elsif ($exPression eq "<="){if ($tmpLine <= $values){ $found++; }}
elsif ($exPression eq "=="){if ($tmpLine == $values){ $found++; }}
elsif ($exPression eq "!="){if ($tmpLine != $values){ $found++; }}
elsif ($exPression eq "!!"){if ($tmpLine != $values){ $found++; }}
elsif ($exPression eq "ne"){if ($tmpLine ne $values){ $found++; }}
else{error("Incorrect exPression - $exPression")}
if($found){
$Found++;
$content->{$line[$keyPosition]}->{'record'} = $line[$keyPosition];
foreach $name (@field_name){$content->{$line[$keyPosition]}->{$name} = $line[$a++];}
}
}
elsif(%searchByField){
my $found=0; my $length=0;
for $field (keys %searchByField){
if($method eq "perfect"){if ($line[$position{$field}] eq $searchByField{$field}){ $found++; } }
elsif($line[$position{$field}] =~m/$searchByField{$field}/i){$found++;}
$length++;
}
if($found == $length){
$Found++;
$content->{$line[$keyPosition]}->{'record'} = $line[$keyPosition];
foreach $name (@field_name){$content->{$line[$keyPosition]}->{$name} = $line[$a++];}
}
}
elsif(@keys){
if(@fields){
my $found=0;
for $field (@fields){
foreach $word (@keys){
if($method eq "perfect"){if ($line[$position{$field}] eq $word){$found++; last;} }
elsif($line[$position{$field}] =~m/$word/i){$found++;}
}
}
if(($method eq "all" && $found>=@keys) or ($method ne "all" && $found)){
$Found++;
$content->{$line[$keyPosition]}->{'record'} = $line[$keyPosition];
foreach $name (@field_name){$content->{$line[$keyPosition]}->{$name} = $line[$a++];}
}
}
else{
my $found=0;
foreach $word (@keys){
foreach $value (@line){
if($method eq "perfect"){if($value eq $word){$found++; last;}}
elsif($value=~m/$word/i){$found++;}
}
}
if(($method eq "all" && $found>=@keys) or ($method ne "all" && $found)){
$Found++;
$content->{$line[$keyPosition]}->{'record'} = $line[$keyPosition];
foreach $name (@field_name){$content->{$line[$keyPosition]}->{$name} = $line[$a++];}
}
}
}
else{
$Found++;
$content->{$line[$keyPosition]}->{'record'} = $line[$keyPosition];
foreach $name (@field_name){$content->{$line[$keyPosition]}->{$name} = $line[$a++];}
}
$Total++;
}
}
else{
$content->{$line[$keyPosition]}->{'record'} = $line[$keyPosition];
foreach $name (@field_name){$content->{$line[$keyPosition]}->{$name} = $line[$a++];}
}
}
return $content;
}
sub get_record{
my $text = $_[0];
$text =~ s{<<(.*?)>>}{exists($INSERT{$1}) ? $INSERT{$1} : ""}gsex;
return $text;
}
sub get_html{
my @txt = read_file($_[0]);
foreach(@txt){$txt.=$_;}
$txt=~/(.*)(.*)<\/template>(.*)/s;
error("Template-tag not found!") if !$1 or !$2;
return ($1,$2,$3);
}
##########################################################
#CREATE DATABASE COMAND LINE
##########################################################
sub create_db{
open(F, ">$databasefile") || error ("Can't create DB-file!");
print F "ID|headline|address|city|province|postalcode|manager|telephone|email|description|available|bedrooms|price|image|image2|feature|show|DATE\n";
close F;
}
##########################################################
sub default{
$records=$FORM{'headlines'};
if($FORM{mode} eq 'admin'){main(); return;}
record($FORM{record}) if $FORM{record};
show() unless $default_mode;
if($default_mode ==3){
$records=$Number_of_headlines_to_scroll;
}
elsif($default_mode ==2){
($head2, $tmp2, $foot2) = get_html($record_template);
$records=$Number_of_news;
}
$data=read_base(1);
my $i=0;
for(sort {$a <=> $b} keys %$data){@records[$i++]=$_;}
if($news_up){@records = reverse @records;}
$records=@records if $records > @records;
$records=@records if !$records;
my $txt;
($head, $tmp, $foot) = get_html($html_template);
##########################################################
#HEADLINE IMAGE
##########################################################
for(0..$records-1){
%INSERT={};
foreach $name (@field_name){$INSERT{$name}=$data->{$records[$_]}->{$name};}
$INSERT{image} = "![](\"$INSERT{image}\") " if $INSERT{image};
if($INSERT{headline} ne ''){
$INSERT{image} = "" if $INSERT{image};
$INSERT{more} = " {$records[$_]}->{'record'}.">More Info »";
}
if ($default_mode ==2){
$INSERT{headline} = "$INSERT{headline}";
$down.= get_record($tmp2)."Top $news_news_separator";
$INSERT{headline} =~s/name="news$_"/href="#news$_"/s;
$INSERT{more} = " More Info";
}
elsif ($default_mode ==3){$marquee.=" {$records[$_]}->{'record'}.">$INSERT{headline} ";}
else{$INSERT{headline} = "{$records[$_]}->{'record'}.">$INSERT{headline}" if $INSERT{biography} ne '';}
$result.= get_record($tmp);
}
if($default_mode ==3){$result="";}
print $result;
print $head_news_separator.$down if $default_mode ==2;
exit;
}
##########################################################
#INSERT IMAGE
##########################################################
sub record{
$data=read_base();
($head, $tmp, $foot) = get_html($record_template);
foreach $name (@field_name){$INSERT{$name}=$data->{$_[0]}->{$name};}
$INSERT{image} = "" if $INSERT{image};
$INSERT{image2} = "$INSERT{image2}" if $INSERT{image2};
$INSERT{image3} = "$INSERT{image3}" if $INSERT{image3};
$INSERT{image4} = "$INSERT{image4}" if $INSERT{image4};
$INSERT{image5} = "$INSERT{image5}" if $INSERT{image5};
$INSERT{image6} = "$INSERT{image6}" if $INSERT{image6};
$INSERT{headline} =~s/
/ /ig;
$result = get_record($tmp);
print get_record($head), $result, $foot;
exit;
}
##########################################################
#ADD NEW FIELD
##########################################################
sub add_field{
$data=read_base();
$txt .= qq|| Diva's Advertising Administration |
|---|
|
Add new person
Return to list|;
$txt .= qq| Logout |
| |
| Add new field in database |
|---|
|;
if($FORM{new_field}){
add_new_field($FORM{new_field});
$txt.= qq|
Field <$FORM{new_field}> has added! | |;}
else{
$txt.= qq|
\n";
return;
}
sub add_new_field{
my @data = read_file("$databasefile");
my $name = shift;
$name =~ s/ /_/g;
my $a=0;
chomp $data[0];
@fields = split('\|', $data[0]);
foreach(@fields){
error("Field <$name> already use in database!") if $name eq $_;
}
foreach (@data){
chomp $data[$a];
$data[0].="|".$name."\n" if $a==0;
$data[$a].="|\n" if $a!=0;
$a++;
}
open (F, ">$databasefile") || error("Can't open file for alter table");
print F join ("", @data);
close F;
}
##########################################################
sub show{
$data=read_base(1);
($head, $tmp, $foot) = get_html($html_template);
$FORM{order_by} ||= "number";
$FORM{order} ||="123";
for(@DateFields){$DateFields{$_}=1;}
$i=0;
$myOrder = $FORM{order_by};
if($DateFields{$FORM{order_by}}){
for(keys %$data){($data->{$_}->{"DATE_".$myOrder}=$data->{$_}->{$FORM{order_by}})=~s/-//g;}
$FORM{order_by} = "DATE_".$myOrder;
}
if($FORM{order} eq "123"){for(sort { $data->{$a}->{$FORM{order_by}} <=> $data->{$b}->{$FORM{order_by}} } keys %$data){$records[$i++]=$_;}}
elsif($FORM{order} eq "321"){for(sort { $data->{$b}->{$FORM{order_by}} <=> $data->{$a}->{$FORM{order_by}} } keys %$data){$records[$i++]=$_;}}
elsif($FORM{order} eq "cba"){for(sort { $data->{$b}->{$FORM{order_by}} cmp $data->{$a}->{$FORM{order_by}} } keys %$data){$records[$i++]=$_;}}
else{for(sort { $data->{$a}->{$FORM{order_by}} cmp $data->{$b}->{$FORM{order_by}} } keys %$data){$records[$i++]=$_;}}
$FORM{order_by} = $myOrder;
my $txt;
$page = param('page');
$show_records = @records;
$records_per_page = $FORM{headlines} if $FORM{headlines};
$start = $page*$records_per_page;
$end = $start + $records_per_page-1;
$end = $show_records-1 if $end>$show_records-1;
for($start..$end){
%INSERT={};
foreach $name (@field_name){$INSERT{$name}=$data->{$records[$_]}->{$name};}
$INSERT{image} = "" if $INSERT{image};
if($INSERT{headline} ne ''){
$INSERT{more} = "{$records[$_]}->{'record'}>Details »";
$INSERT{headline} = "$INSERT{headline}";
}
$result.= get_record($tmp);
}
$heads = "&headlines=$FORM{headlines}" if $FORM{headlines};
#set page selector
my $qs = "&order_by=$FORM{order_by}" if $FORM{order_by};
$qs .= "&order=$FORM{order}" if $FORM{order};
$INSERT{records} = @records-1;
$INSERT{page_selector} = "";
my $searchRec =param('search');
$INSERT{page_selector}= "$textPrevious" if $page>0;
my $pageStart=0;
my $pageEnd = 0;
$pageEnd = $INSERT{records}/$records_per_page if $records_per_page;
if($pageSelectorRange){
$pageStart=$page- int($pageSelectorRange/2) if $page- int($pageSelectorRange/2)>0;
if($page$p|;}
}
$INSERT{page_selector}.= " $textNext" if $page < $INSERT{records}/$records_per_page-1 && $records_per_page>1;
$INSERT{search}.=param('search');
$INSERT{'#_matches'}=$Found;
$INSERT{'#_total'}=$Total;
$foot = get_record($foot);
$head = get_record($head);
$result = $not_found unless @records;
print $head, $result, $foot;
exit;
}
##########################################################
#MAIN WINDOW
##########################################################
sub main{
$data=read_base();
$txt .= qq|| Diva's Advertising Administration |
|---|
| Add new Advertiser »|;
$txt .= qq| Add new field| if $add_fields;
$txt .= qq| |
| Options | Advertiser | Date | Position | Show |
|---|
|;
#error($data);
for(sort {$a <=> $b} keys %$data){
$txt.= qq|| Delete Edit | $data->{$_}->{'headline'} | |;
$txt.= qq|$data->{$_}->{'DATE'} | |;
$txt.= qq|$data->{$_}->{'position'} | |;
$txt.= qq|$data->{$_}->{'show'} | |;
$txt.= qq| |;
}
$txt.="
\n";
}
##########################################################
#VIEW WINDOW
##########################################################
sub view{
$data=read_base();
$current = $FORM{record};
$txt .= qq|| Diva's Advertising Administration |
|---|
| Return to Main List | |;
$txt .= qq|| Course: $data->{$FORM{record}}->{'headline'}$data->{$FORM{record}}->{'last_name'} Edit this Course |
| Course Date: | $data->{$FORM{record}}->{'course_date'} |
| Numerical Date: | $data->{$FORM{record}}->{'DATE'} |
| Course: | $data->{$FORM{record}}->{'headline'} |
| Course Overview: | $data->{$FORM{record}}->{'titles'} |
| Instructor: | $data->{$FORM{record}}->{'instructor'} |
| Fee: | $data->{$FORM{record}}->{'fee'} |
| Location: | $data->{$FORM{record}}->{'location'} |
| Course Description: | $data->{$FORM{record}}->{'description'} | |;
$txt .= qq| | Show: | $data->{$FORM{record}}->{'show'} | |;
#if($add_fields){
# for(9..@field_name-1){$txt .= qq||;}
#}
$txt .= qq| | |;
$txt .= qq|<< previous | unless $current==1;
for(sort {$a <=> $b} keys %$data){
$txt .= qq| [|;
$txt .= qq|| unless $_ eq $FORM{record};
$txt .= qq|$_|;
$txt .= qq|| unless $_ eq $FORM{record};
$txt .= qq|] |;
}
$txt .= qq| next >>| if $current<$length;
$txt .= qq| | |;
}
sub save_image{
$file=param($_[0]);
$file =~m/([^\\\/]*\.\w*\Z)/i;
$filename=$1;
open(FILE,">$_[1]/$1") || error("Can't save image file!");
binmode FILE;
while ($bytesread=read($file,$buffer,1024)) {print FILE $buffer;}
close(FILE);
return "$filename";
}
##########################################################
#SAVE IMAGE PATH
##########################################################
sub save{
$data=read_base();
my $new_record;
foreach(@field_name){
my $text;
if($_ eq 'image' && param('image') ne ''){
$dir = $image_dir; $text = $image_url."/";
$text .= save_image($_, $dir);
}
elsif($_ eq $ID_autoincrement_name){
if(param('record')) {$text .= param('record');}
else{ #find max ID;
for(keys %$data){$maxID = $data->{$_}->{$ID_autoincrement_name} if $maxID < $data->{$_}->{$ID_autoincrement_name}; }
++$maxID;
$text .= $maxID;
}
}
elsif($_ eq 'image' && param('_image')){$text .=param('_image');}
elsif($_ eq 'image' && param('set_image')){$text .="$image_url/".param('set_image');}
elsif($_ eq 'image2' && param('image2') ne ''){
$dir = $image_dir; $text = $image_url."/";
$text .= save_image($_, $dir);}
elsif($_ eq 'image3' && param('image3') ne ''){ $dir = $image_dir; $text = $image_url."/"; $text .= save_image($_, $dir);}
elsif($_ eq 'image4' && param('image4') ne ''){ $dir = $image_dir; $text = $image_url."/"; $text .= save_image($_, $dir);}
elsif($_ eq 'image5' && param('image5') ne ''){ $dir = $image_dir; $text = $image_url."/"; $text .= save_image($_, $dir);}
elsif($_ eq 'image6' && param('image6') ne ''){ $dir = $image_dir; $text = $image_url."/"; $text .= save_image($_, $dir);}
elsif($_ eq 'image2' && param('_image2')){$text .=param('_image2');}
elsif($_ eq 'image2' && param('set_image2')){$text .="$image_url/".param('set_image2');}
elsif($_ eq 'image3' && param('_image3')){$text .=param('_image3');}
elsif($_ eq 'image3' && param('set_image3')){$text .="$image_url/".param('set_image3');}
elsif($_ eq 'image4' && param('_image4')){$text .=param('_image4');}
elsif($_ eq 'image4' && param('set_image4')){$text .="$image_url/".param('set_image4');}
elsif($_ eq 'image5' && param('_image5')){$text .=param('_image5');}
elsif($_ eq 'image5' && param('set_image5')){$text .="$image_url/".param('set_image5');}
elsif($_ eq 'image6' && param('_image6')){$text .=param('_image6');}
elsif($_ eq 'image6' && param('set_image6')){$text .="$image_url/".param('set_image6');}
elsif($_ eq 'show'){$text=param($_); $text="No" unless param($_);}
elsif($_ eq 'feature'){$text=param($_); $text="No" unless param($_);}
else{
$text=param($_);
$text=~s/\n/
/g;
$text=~s/\r//g;
$text=~s/\|/I/g;
}
$new_record .= $text."|";
}
chop $new_record;
$new_record .= "\n";
if(param('record')){
open (F, "$databasefile") || error("Can't open databasefile!");
@data = ;
close F;
for(1..@data-1){
@row = split('\|', $data[$_]);
if($row[$keyPosition] eq $FORM{record}){$data[$_] = $new_record; last;}
}
open (F, ">$databasefile") || error("Can't open databasefile!");
foreach(@data) {print F }
close F;
}
else{
open (F, ">>$databasefile") || error("Can't open databasefile!");
print F $new_record;
close F;
}
main();
}
sub delete{
if($FORM{record}){
open (F, "$databasefile") || error("Can't open databasefile!");
@data = ;
close F;
@field_name=split('\|',$data[0]);
my $p=0;
$keyPosition = -1;
foreach(@field_name){
$keyPosition = $p if $_ eq $ID_autoincrement_name;
$p++;
}
error("Can't find key in db file!") if $keyPosition == -1;
for(1..@data-1){
@row = split('\|', $data[$_]);
if($row[$keyPosition] eq $FORM{record}){$data[$_] = ""; last;}
}
open (F, ">$databasefile") || error("Can't open databasefile!");
foreach(@data) {print F }
close F;
}
main();
}
sub add{
$data=read_base();
if ($_[0]){
$hidden=qq||;
$data->{$FORM{record}}->{'short_text'}=~s/
/\n/g;
$data->{$FORM{record}}->{'headline'}=~s/
/\n/g;
$image = "{$FORM{record}}->{'image'} checked>{$FORM{record}}->{'image'} target=_blank>$data->{$FORM{record}}->{'image'}
" if $data->{$FORM{record}}->{'image'};
$image2 = "{$FORM{record}}->{'image2'} checked>{$FORM{record}}->{'image2'} target=_blank>$data->{$FORM{record}}->{'image2'}
" if $data->{$FORM{record}}->{'image2'};
$image3 = "{$FORM{record}}->{'image3'} checked>{$FORM{record}}->{'image3'} target=_blank>$data->{$FORM{record}}->{'image3'}
" if $data->{$FORM{record}}->{'image3'};
$image4 = "{$FORM{record}}->{'image4'} checked>{$FORM{record}}->{'image4'} target=_blank>$data->{$FORM{record}}->{'image4'}
" if $data->{$FORM{record}}->{'image4'};
$image5 = "{$FORM{record}}->{'image5'} checked>{$FORM{record}}->{'image5'} target=_blank>$data->{$FORM{record}}->{'image5'}
" if $data->{$FORM{record}}->{'image5'};
$image6 = "{$FORM{record}}->{'image6'} checked>{$FORM{record}}->{'image6'} target=_blank>$data->{$FORM{record}}->{'image6'}
" if $data->{$FORM{record}}->{'image6'};
}
if($select_image){
opendir(DIR, "$image_dir");
foreach(readdir DIR)
{
$img_select.="\n" if -f "$image_dir/$_" && $_=~m/.\gif|.\jpg/i;
}
close DIR;
$img_select1 = "
";
$img_select2 = "
";
}
$feature = "checked" unless $data->{$FORM{record}}->{'feature'} eq "No";
$show = "checked" unless $data->{$FORM{record}}->{'show'} eq "No";
$left = "selected" if $data->{$FORM{record}}->{'image_align'} eq "left";
$center = "selected" if $data->{$FORM{record}}->{'image_align'} eq "center";
$right = "selected" if $data->{$FORM{record}}->{'image_align'} eq "right";
$left2 = "selected" if $data->{$FORM{record}}->{'image_align2'} eq "left";
$center2 = "selected" if $data->{$FORM{record}}->{'image_align2'} eq "center";
$right2 = "selected" if $data->{$FORM{record}}->{'image_align2'} eq "right";
##########################################################
#EDIT WINDOW
##########################################################
$data->{$FORM{record}}->{'description'}=~s/
/\n/ig;
$txt .= qq|
|
|
|
#!/usr/bin/perl
############################################
## ##
## CounterLog ##
## by Darryl Burgdorf ##
## (e-mail burgdorf@awsd.com) ##
## ##
## version: 1.22 ##
## last modified: 07/05/01 ##
## license modified: 4/13/06 ##
## copyright (c) 2001 ##
## ##
## latest version is available from ##
## http://awsd.com/scripts/ ##
## ##
############################################
# COPYRIGHT NOTICE:
#
# Copyright 2001 Darryl C. Burgdorf.
#
# This program is free software. You can redistribute it and/or
# modify it under the terms of either:
#
# a) the GNU General Public License as published by the Free Software
# Foundation, either version 1 or (at your option) any later version,
#
# or
#
# b) the "Artistic License" which comes with this program.
#
# You should have received a copy of the Artistic License with this
# module, in the file artistic.txt. If you did not, I'll be glad to
# provide one.
#
# You should have received a copy of the GNU General Public License
# along with this program. If you did not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston MA 02111-1307.
#
# Selling the code for this program without prior written consent is
# expressly forbidden. Obtain permission before redistributing this
# program over the Internet or in any other medium. In all cases
# copyright and header must remain intact.
# DESCRIPTION:
#
# CounterLog monitors accesses to any pages which contain an SSI code
# referencing it. It can create NCSA-format agent and referer logs,
# which can be handy if your server doesn't happen to already provide
# you with that information. It can also be used to put text-based
# access counters on some or all of your pages. (Requires SSI.)
# VERSION HISTORY:
#
# 1.22 07/05/01 Updated spider/robot filter lists
# 1.21 01/09/01 SCRIPT NOW REQUIRES PERL 5
# Added $HourOffset variable
# Added optional "idiot filter" file
# 1.20 12/25/00 Added spider/robot filter
# Allowed script to be called via JavaScript tag
# 1.13 07/04/98 Rewrote file locking routines
# 1.12 05/02/98 Trapped "run on" URLs
# Modified lock routine cycle time
# 1.11 03/09/98 Corrected new glitch in URL processing
# Made agent & referer logs optional
# 1.10 01/23/98 Added "today's" hits to counter display
# Yet a few more small tweaks
# 1.02 08/06/97 A few small tweaks
# 1.01 05/05/97 Fixed minor bug in file locking
# Minor format changes
# 1.00 02/25/97 Initial "public" release
#########
# SETUP #
#########
# Any page you want monitored should contain somewhere the following
# SSI code:
#
#
#
# (If you've put the CounterLog script somewhere other than in your
# cgi-bin directory, the location should be revised accordingly.)
#
# If you're putting a counter on the page, of course, the SSI code
# should be placed on the page where you want the counter to appear.
# Otherwise, it makes no difference at all where you put it.
# Alternately, you can call CounterLog via a JavaScript tag:
#
#
#
# If you call the script in this manner, you won't need to worry
# about making sure your pages are set to be parsed by the server
# for SSI content. Of course, on the down side, you won't be able
# to count hits from anyone who visits your page with a browser that
# doesn't support JavaScript, or who visits with JavaScript turned
# off.
# The following variables define the location of the three log files.
# Make sure that the files actually exist and that they are set world-
# writable! $AccessFile *has* to be defined; the other two are
# optional, and should only be defined if you want CounterLog to
# create the agent and/or referer log files.
$AccessFile = "/home/content/N/i/n/NinaSutton/html/count_access.txt";
$AgentFile = "/home/content/N/i/n/NinaSutton/html/count_agent.txt";
$RefererFile = "/home/content/N/i/n/NinaSutton/html/count_referer.txt";
# The following variable allows you to define the location of an
# optional "idiot filter" file. If this file exists, CounterLog will
# keep track of what IP addresses have visited your pages, and will
# prevent any given IP address from registering as more than a single
# visit to any given page within a half-hour period. This will make
# it impossible for a visitor to artificially inflate your count by
# repeatedly reloading your pages.
#$IdiotFilterFile = "/usr/www/users/foo/idiotfilter.txt";
# If $IncludeDomain is set to "1" the access and referer logs will
# include the domain of the local pages accessed. This can be handy
# if you have several different virtual domains on the system, and want
# to be able to keep track of accesses to pages with the same names
# (e.g., "index.html") under each domain. Setting it to "0" will
# prevent the domain from being listed.
$IncludeDomain = 1;
# If $IgnoreIntRefs is set to "1" the referer log will *not* list
# references from another page within the same domain. (This works
# regardless of the setting of $IncludeDomain.) This helps to keep
# the size of the referer log down. Set this to "0" if you need to
# know how often people are coming to a given page from each of
# several other pages on the same site, but set it to "1" if you're
# really only interested in knowing which outside pages link to yours.
$IgnoreIntRefs = 1;
# If you want to ignore accesses from specific domain names and/or
# IP numbers, list them here:
@IgnoreIP = ();
# By default, the CounterLog script prints nothing on a page which
# accesses it. If you want it to print a counter number on the page,
# list it here as it appears on the access list:
@PlainCounter = ("dealsfordivas.com/index.shtml");
# If you want a particular page to feature an ordinalized counter
# (e.g., 1st, 2nd, 3rd, etc.) rather than a plain counter, list it
# here:
@OrdCounter = ("foo.com/file3.html","foo.com/file4.html");
# If your system supports the flock() command, set the
# $UseLocking variable to "1"; set it to "0" otherwise.
$UseLocking = 1;
# If you and your server are in different time zones, you can define
# $HourOffset so that the script uses *your* time instead of the
# server's. For example, if your server is in the Eastern time zone,
# but you're in the Pacific time zone, you would want to define this
# variable as -3. (This is really only relevant in determining when
# new daily counts should be started, of course.)
$HourOffset = 0;
###############
# ACCESS FILE #
###############
$time = time;
$time += ($HourOffset*3600);
if ($ENV{'QUERY_STRING'} =~ /jscript/) {
print "Cache-Control: no-cache\n";
print "Pragma: no-cache\n";
print "Content-type: application/x-javascript\n\n";
}
else {
print "Content-type: text/html\n\n";
}
if ($ENV{'QUERY_STRING'} =~ /jscript/) {
$doc_uri = $ENV{'HTTP_REFERER'};
$doc_uri =~ s/.*\/\///g;
$doc_uri =~ s/^www\.//i;
}
else {
if (defined $ENV{'DOCUMENT_URI'}) {
$doc_uri = $ENV{'DOCUMENT_URI'};
if (defined $ENV{'SERVER_NAME'}) {
$server = $ENV{'SERVER_NAME'};
$server =~ s/www\.//i;
if ($IncludeDomain) {
$doc_uri = $server . $doc_uri;
}
}
}
else { $doc_uri = ""; }
}
$doc_uri =~ s#([^:])//#$1/#go;
$doc_uri =~ s#\.((s|p)*html*)/.*$#\.$1#o;
$doc_uri =~ s#/$##o;
$harvester_list = 'bullseye|cherrypicker|crescent|emailcollector|emailsiphon|emailwolf|extractor|microsoft url|mozilla/3.mozilla/2.01|newt|nicerspro|webbandit|brutus';
$download_list = 'da \d|dnload|download|fetch|flashget|ftp|getright|gozilla|jetcar|leach|leech';
$linkchecker_list = 'analyze|check|link|netmechanic|netmind|powermarks|redalert|tooter|validat|verif|walk';
$offline_list = 'avantgo|batch|copier|httrack|msiecrawler|msproxy|netattache|netscape-proxy|offline|spacebison|teleport|webcapture|webzip';
$spider_list = 'aport|archive|ask jeeves|behold|borg|bot|catch|crawl|digger|elitesys|enfish|esense|euroseek|ferret|grab|griffon|gulliver|harvest|htdig|hubat|hunt|infoseek|java|leia|lwp-|lwp:|mantraagent|mapper|mata hari|mercator|netants|perl|quest|reader|reaper|roamer|rover|scooter|search|slurp|snatch|spider|spinne|spyder|sweep|t-h-u-n-d-e-r-s-t-o-n-e|ultraseek|url|utopy|webcollage|webster pro|webwhacker|wfarc|wget|whatuseek';
if (($ENV{'HTTP_USER_AGENT'} =~ m#$harvester_list#oi)
|| ($ENV{'HTTP_USER_AGENT'} =~ m#$download_list#oi)
|| ($ENV{'HTTP_USER_AGENT'} =~ m#$linkchecker_list#oi)
|| ($ENV{'HTTP_USER_AGENT'} =~ m#$offline_list#oi)
|| ($ENV{'HTTP_USER_AGENT'} =~ m#$spider_list#oi)) {
unless (($ENV{'HTTP_USER_AGENT'} =~ m#robotics#oi) || ($ENV{'HTTP_USER_AGENT'} =~ m#hotjava#oi)) {
$NoCountHit = 1;
}
}
if ((defined $ENV{'REMOTE_ADDR'}) && (defined @IgnoreIP) && !($NoCountHit)) {
foreach $ignoredip (@IgnoreIP) {
if ($ENV{'REMOTE_ADDR'} =~ /$ignoredip/i) {
$NoCountHit = 1;
}
}
}
if ($IdiotFilterFile && !($NoCountHit)) {
&LockOpen (IDIOTFILTER,"$IdiotFilterFile");
undef (@idiotfilter);
while (defined($idiotfilterline = )) {
chomp ($idiotfilterline);
$idiotfiltertime = int($idiotfilterline);
unless (($time-$idiotfiltertime) > 1800) {
push (@idiotfilter,$idiotfilterline);
if ($idiotfilterline =~ /^\d+ $doc_uri $ENV{'REMOTE_ADDR'}/) {
$NoCountHit = 1;
}
}
}
seek(IDIOTFILTER, 0, 0);
foreach $idiotfilterline (@idiotfilter) {
print IDIOTFILTER "$idiotfilterline\n";
}
unless ($NoCountHit) {
print IDIOTFILTER "$time $doc_uri $ENV{'REMOTE_ADDR'}\n";
}
truncate (IDIOTFILTER, tell(IDIOTFILTER));
&LockClose (IDIOTFILTER,"$IdiotFilterFile");
}
&LockOpen (COUNT,"$AccessFile");
$location = tell COUNT;
while ($line = ) {
if (($acc,$day,$dayacc,$uri) = ($line =~ /^(\d+) (\d+) (\d+) '(\S+)'$/)) {
if ($uri eq $doc_uri) {
last;
}
}
last if ($uri eq $doc_uri);
$location = tell COUNT;
$acc = 0;
$dayacc = 0;
}
$acc = int($acc);
unless ($NoCountHit) { $acc += 1; }
($mday,$mon,$year) = (localtime($time))[3,4,5];
$year += 1900;
if ($mday < 10) { $mday = "0".$mday; }
$mon += 1;
if ($mon < 10) { $mon = "0".$mon; }
$today = $year.$mon.$mday;
$dayacc = int($dayacc);
unless ($day eq $today) { $dayacc = 0; }
unless ($NoCountHit) { $dayacc += 1; }
foreach $key (@PlainCounter) {
if ($doc_uri eq $key) {
$printacc = &commas($acc);
$printdayacc = &commas($dayacc);
last;
}
}
foreach $key (@OrdCounter) {
if ($doc_uri eq $key) {
$printacc = &commas($acc) . &ordinalize($acc);
$printdayacc = &commas($dayacc) . &ordinalize($dayacc);
last;
}
}
if ($printacc) {
$printline = "$printacc";
if ($ENV{'QUERY_STRING'} =~ /jscript/) {
$printline = &JSoutput($printline);
}
print "$printline";
}
if ($doc_uri) {
seek(COUNT, $location, 0);
$longacc = sprintf("%010.10d", $acc);
$longdayacc = sprintf("%010.10d", $dayacc);
print COUNT "$longacc $today $longdayacc '$doc_uri'\n";
}
&LockClose (COUNT,"$AccessFile");
##############
# AGENT FILE #
##############
if ($AgentFile && !($NoCountHit)) {
open (COUNT,">>$AgentFile");
if (defined $ENV{'HTTP_USER_AGENT'}) {
$doc_agent = $ENV{'HTTP_USER_AGENT'};
}
else { $doc_agent = ""; }
if ($doc_agent) {
print COUNT "$doc_agent\n";
}
close (COUNT);
}
################
# REFERER FILE #
################
if ($RefererFile && !($NoCountHit)) {
open (COUNT,">>$RefererFile");
if (defined $ENV{'HTTP_REFERER'}) {
$doc_referer = $ENV{'HTTP_REFERER'};
}
else { $doc_referer = ""; }
if ($doc_referer && $doc_uri) {
unless ($IgnoreIntRefs && ($doc_referer =~ m#$server#oi)) {
print COUNT "$doc_referer -> $doc_uri\n";
}
}
close (COUNT);
}
###############
# SUBROUTINES #
###############
sub LockOpen {
local(*FILE,$lockfilename) = @_;
local($TrysLeft) = 100;
unless (-e "$lockfilename") {
open (FILE,">$lockfilename");
print FILE "\n";
close (FILE);
}
if ($UseLocking) {
open (FILE,"+<$lockfilename") || &Error;
flock(FILE,2) || &Error;
}
else {
if ((-e "$lockfilename.lok") && ((stat("$lockfilename.lok"))[9]+30<$time)) {
unlink ("$lockfilename.lok");
}
while ($TrysLeft--) {
if (-e "$lockfilename.lok") {
select(undef,undef,undef,0.01);
}
else {
open (LOCKFILE,">$lockfilename.lok");
print LOCKFILE "\n";
close (LOCKFILE);
last;
}
}
if ($TrysLeft >= 0) {
open (FILE,"+<$lockfilename") || &Error;
}
else {
&Error;
}
}
}
sub LockClose {
local(*FILE,$lockfilename) = @_;
close (FILE);
unlink ("$lockfilename.lok");
}
sub Error {
$printline = "[File Lock Error]";
if ($ENV{'QUERY_STRING'} =~ /jscript/) {
$printline = &JSoutput($printline);
}
print "$printline";
exit(0);
}
sub ordinalize {
local($count) = @_;
local($last, $last2);
$last2 = $count % 100;
$last = $count % 10;
if ($last2 < 10 || $last2 > 13) {
return "st" if $last == 1;
return "nd" if $last == 2;
return "rd" if $last == 3;
}
return "th";
}
sub commas {
local($_)=@_;
1 while s/(.*\d)(\d\d\d)/$1,$2/;
$_;
}
sub JSoutput {
$_[0] =~ s/\"/\\"/g;
$_[0] =~ s/\r//g;
$_[0] =~ s/\n/\")\;\ndocument.write(\" /g;
$_[0] = "document.write(\" $_[0] \");document.close();";
return $_[0];
}
|
|
 |
|
 |
|
