############################################################################## # Cliff's Pic-Post Script Version 4.08 # # Copyright 1998 Shaven Ferret Productions # # Created 6/21/98 Last Modified 09/28/99 # # Available at http://www.shavenferret.com/scripts # ############################################################################## # COPYRIGHT NOTICE # # Copyright 1998 Shaven Ferret Productions All Rights Reserved. # # # # This script can be used\modified free of charge as long as you don't # # change this header, or the parts of this script that generate the return # # link\form. If you really need to remove these, go to # # http://www.shavenferret.com/scripts/register.shtml . By using this script # # you agree to indemnify me from any liability that might arise from its use.# # # # Redistributing\selling the code for this program without prior written # # consent is expressly forbidden. # ############################################################################## sub start { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s/\n/ /g; $FORM{$name} = $value; } &getconfig; &getsetup; unless ($FORM{'action'} eq "random") { print "Content-type: text/html\n\n"; } } sub getsetup { unless(-e "$datadir/setup.txt") { open (DATA, ">$datadir/setup.txt"); print DATA ".shtml|-1|My Pic-Post Page|||138|-1|-1|-1|#FFFFFF|#000000|#DD0000|#FF0000|#BB0000||||0|0|25||||0|-1|||3|-1|c|||0|-1|-1|-1|-1|0|-1\n"; print DATA "Amateur|Babe|Bondage|CloseUp|Cumshot|Gay|Group|Hardcore|Lesbian|Misc|Older|Teen"; close(DATA); } open (DATA, "$datadir/setup.txt"); @lines = ; close(DATA); chomp($lines[0]); chomp($lines[1]); unless ($lines[0]) { print "Content-type: text/html\n\n"; print "Problem

Problem

\n"; print "It looks like the script can't find the data directory. Check the following things:\n"; exit; } ($ex,$approval,$pptitle,$link,$youremail,$maxpics,$notify1,$notify2,$notify3,$bgcolor,$textcolor,$linkcolor,$alink,$vlink,$background,$keywords,$description,$return,$hw,$perpage,$head,$foot,$rules,$moreposts,$samedomain,$searchlink,$fontname,$type_of_link,$hw2,$default_listing,$posthead,$postfoot,$keepsearch,$persite,$givestats,$showhints,$eachrate,$checkapprove,$norate) = split(/\|/, $lines[0]); if ($fontname) { $font = ""; $cfont = ""; } @image_types = split(/\|/,$lines[1]); close(DATA); } sub top { (my $title, my $file, my $key, my $desc, my $titleonly) = @_; print $file "$title\n"; if ($key) { print $file "\n"; } if ($desc) { print $file "\n"; } print $file "\n"; print $file ""; if ($file eq "STDOUT") { if ($title && $titleonly == 0) { print $file "$font

$title

\n"; } } else { print $file "$font
\n"; print $file "$head$counthtml
"; &banners($file); if ($title && $titleonly == 0) { print $file "

$title

\n"; } } } sub topform { (my $action, my $target, my $title) = @_; if ($title) { print "

$title

\n"; } print "
\n"; if ($action) { print "\n"; } if ($FORM{'password'}) { print "\n"; } print "
$font
\n"; } sub closeform { (my $button) = @_; print "$cfont
$font$cfont\n"; print "$font$cfont
\n"; } sub missing { (my $what) = @_; &top("Missing Information"); print "Please click back and enter $what.$cfont\n"; exit; } sub textrow { (my $desc, my $name, my $size, my $value, my $addvar) = @_; unless ($addvar) { $html = ""; } $html .= "$font$desc$cfont$font\n"; $html .= "\n"; $html .= "$cfont\n"; unless ($addvar) { print "$html"; } } sub textarea { (my $desc, my $name, my $value) = @_; print "$font
$desc
\n"; print "$cfont\n"; } sub yesno { (my $desc, my $name, my $value, my $yes, my $no, my $addvar) = @_; unless ($addvar) { $html = ""; } $html .= "\n"; unless ($addvar) { print "$html"; } } sub error { (my $error) = @_; &top("Problem","STDOUT"); print "$error$cfont\n"; exit; } sub sig { # Changing this sub, or any place where it is called is illegal. If you # really need to remove it, register the script at # http://www.shavenferret.com/scripts/register.shtml . It will cost a great # deal less than the lawsuit you'll face if you screw with this without # paying. (my $which) = @_; if ($return) { $rlink = $return; } else { srand(); $rlink = int(rand(2)); if ($rlink == 0) { $rlink = -1; } } if ($rlink == -1) { print $which "

Pic-Post script by Cliff(tm), Shaven "; print $which "Ferret Productions, and can be found at http://www."; print $which "shavenferret.com/scripts.
\n"; } else { print $which "
\n"; print $which "
$font"."$desc$cfont$font$cfont
\n"; print $which "
FREE ADULT STORIES IN YOUR MAILBOX\n"; print $which "
Just enter your e-mail address, and click subscribe! You'll receive a\n"; print $which "free adult story in your mailbox every week, and your address will not\n"; print $which "be given to anyone or used to spam you.\n"; print $which "
\n"; print $which "
\n"; print $which "
\n"; print $which "\n"; print $which "
\n"; } } sub getimage { (my $num) = @_; ($image_type,$image_url,$height,$width,$image_desc,$site_url,$site_name,$site_desc,$email,$link_url,$odate,$otime,$banner_url,$banner_height,$banner_width,$link_choice,$posters_ip,$index_num) = split(/\|/,$lines[$num]); chomp($index_num); } sub gettime { ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time))[0,1,2,3,4,5]; if ($sec < 10) { $sec = "0$sec"; } if ($min < 10) { $min = "0$min"; } if ($hour < 10) { $hour = "0$hour"; } if ($mday < 10) { $mday = "0$mday"; } $mon++; $year += 1900; $date = "$mon/$mday/$year"; $time = "$hour:$min:$sec"; } sub makepage { (my $prefix, my $typeofpage) = @_; my $pagenum = 0; unless (@order) { $order[0] = ""; } while(@order) { open(MAIN,">$postdir/$prefix$pagenum$ex"); &top("$pptitle -- $typeofpage","MAIN",$keywords,$description,1); print MAIN "

$pptitle -- $typeofpage

\n"; &jump("MAIN"); &sig("MAIN"); $lastpage = $pagenum - 1; $lastpage = "$posturl/$prefix$lastpage$ex"; $nextpage = $pagenum + 1; $nextpage = "$posturl/$prefix$nextpage$ex"; unless ($pagenum == 0) { print MAIN "
[ Last Page ]
"; } print MAIN "
\n"; unless ($prefix =~ /i\d/ || $#image_types <= 0) { print MAIN "
$font\n"; print MAIN "category$cfont
\n"; } else { print MAIN "\n"; print MAIN "\n"; for ($postnum = 1; $postnum <= $perpage; $postnum++) { if ($order[0]) { ($junk,$num) = split(/\|/,$order[0]); if ($lines[$num]) { &getimage($num); $temp = $image_type; $temp =~ tr/A-Z/a-z/; unless ($prefix =~ /i\d/ || $#image_types <= 0) { print MAIN "\n"; unless ($norate) { open(FILE,"$datadir/r$index_num.txt"); my $stuff = ; close(FILE); ($total,$votes,$junk) = split(/\|/,$stuff); if ($votes) { $rating = sprintf("%.2f", $total / $votes); } else { $rating = "5"; } print MAIN "\n"; } else { print MAIN "\n"; } } } splice(@order,0,1); } print MAIN "
\n"; } print MAIN "$font
Description
$cfont
$font
\n"; unless ($norate) { print MAIN "Rating"; } else { print MAIN "Posted on.."; } print "
$cfont
$font
$image_type
$cfont
\n"; } else { print MAIN "
\n"; } print MAIN "$font
$image_desc
$cfont
$font
$rating
$cfont
$font
$odate
$cfont
\n"; if ($#order >= 0) { print MAIN "
[ Next Page ]
"; } print MAIN "Webmasters: Click here to add your link and image!\n"; &searchwindow("MAIN"); &sig("MAIN"); &banners("MAIN"); print MAIN "
$foot"; close(MAIN); $pagenum++; } } sub update { open(FILE,"$datadir/posts.txt"); @lines = ; close(FILE); &rotateout; if ($link =~ /$counturl\?/) { open(FILE,"$datadir/l-main.txt"); @returns = ; close(FILE); for ($i = 0; $i <= $#returns; $i++) { ($returnlink,$filename) = split(/\|/,$returns[$i]); chomp($filename); open(FILE,"$datadir/l-$filename.txt"); my $temp = ; close(FILE); my @stuff = split(/\|/,$temp); $RETURNLINK{$returnlink} = $stuff[0]; } close(FILE); } if ($#image_types > 0) { for ($i = 0; $i <= $#image_types; $i++) { $temp = $image_types[$i]; $temp =~ tr/A-Z/a-z/; $TYPE{$temp} = $i; } } if ($counturl =~ /^http\:\/\/$ENV{'HTTP_HOST'}(.+)/) { $counthtml = ""; } if ($FORM{'rp'}) { for ($image_num = 0; $image_num <= $#lines; $image_num++) { &getimage($image_num); open(FILE,">$postdir/$index_num$ex"); &top($image_desc,"FILE",$keywords,$image_desc,1); print FILE "

$pptitle

$image_desc

\n"; &jump("FILE"); &sig("FILE"); if ($width < 400) { $tbwidth = 400; } else { $tbwidth = $width; } print FILE "
\n"; print FILE "\n"; print FILE "\n"; print FILE "
\n"; print FILE "\"$image_desc\"
$font\n"; if ((($type_of_link == 1 || $type_of_link == 3) || ($type_of_link == 2 && $link_choice)) && $banner_url) { print FILE "\n"; print FILE "\"$site_name\"";
\n"; } if ($type_of_link == 0 || ($type_of_link == 2 && $link_choice == 0)) { print FILE "$site_name
\n"; } if ($type_of_link == 3 || $type_of_link == 0 || ($type_of_link == 2 && $link_choice == 0) && $site_desc) { print FILE "$site_desc"; } print FILE "$cfont
\n"; unless ($norate) { print FILE "\n"; print FILE "\n"; print FILE "
$font"."Rate this image:
\n"; print FILE "Please be as objective as possible. If you give every image a high rating, then this system becomes worthless.$cfont
$font
\n"; } print FILE "
\n"; &searchwindow("FILE"); &sig("FILE"); &banners("FILE"); print FILE "
$foot$cfont\n"; close(FILE); $order[$image_num] = "0|$image_num"; } } else { for ($image_num = 0; $image_num <= $#lines; $image_num++) { $order[$image_num] = "0|$image_num"; } } &makepage("c","Chronological Order"); @order = (); if ($link =~ /$counturl\?/) { if ($FORM{'rt'} || -e "$datadir/t-order.txt" == 0) { for ($i = 0; $i <= $#lines; $i++) { &getimage($i); unless ($RETURNLINK{$link_url}) { $RETURNLINK{$link_url} = "0"; } $order[$i] = "$RETURNLINK{$link_url}|$i"; } @order = reverse(sort { $a-0 <=> $b-0 } @order); open(FILE,">$datadir/t-order.txt"); foreach $postorder(@order) { print FILE "$postorder\n"; } close(FILE); } else { open(FILE,"$datadir/t-order.txt"); @order = ; close(FILE); for ($i = 0; $i <= $#order; $i++) { chomp($order[$i]); } } &makepage("l","By Traffic"); } if ($FORM{'rr'} || -e "$datadir/r-order.txt" == 0) { for ($i = 0; $i <= $#lines; $i++) { &getimage($i); open(FILE,"$datadir/r$index_num.txt"); my $junk = ; close(FILE); ($total,$votes,$last) = split(/\|/,$junk); if ($votes) { $rating = sprintf("%.2f", $total / $votes); } else { open(FILE,">$datadir/r$index_num.txt"); print FILE "5|1|"; close(FILE); $rating = 5; } $order[$i] = "$rating|$i"; } @order = reverse(sort { $a-0 <=> $b-0 } @order); open(FILE,">$datadir/r-order.txt"); foreach $postorder(@order) { print FILE "$postorder\n"; } close(FILE); } elsif ($norate == 0) { open(FILE,"$datadir/r-order.txt"); @order = ; close(FILE); for ($i = 0; $i <= $#order; $i++) { chomp($order[$i]); } } unless ($norate) { &makepage("r","By Rating"); } if ($#image_types > 0) { for ($itype = 0; $itype <= $#image_types; $itype++) { for ($i = 0; $i <= $#lines; $i++) { &getimage($i); if ($image_type eq $image_types[$itype]) { splice(@order,$#order+1,0,"0|$i"); } } &makepage("i$itype-",$image_types[$itype]); } } open(FILE,"$postdir/$default_listing"."0$ex"); @lines = ; close(FILE); open(FILE,">$mainpath"); foreach $line(@lines) { print FILE "$line"; } close(FILE); } sub banners { (my $filename) = @_; open(BANNERS,"$datadir/banners.txt"); my @banners = ; close(BANNERS); srand; my $bannernum = int(rand($#banners+1)); print $filename "$banners[$bannernum]"; } sub jump { (my $filename) = @_; print $filename "
$fontView Images:
\n"; unless ($prefix eq "c") { print $filename "[Chronologically]\n"; } unless ($prefix eq "r" || $norate) { print $filename "[By Ratings]\n"; } unless ($prefix eq "l" || $link !~ /$counturl\?/) { print $filename "[By Traffic]\n"; } if ($#image_types > 0) { for ($i = 0; $i <= $#image_types; $i++) { unless ($prefix eq "i$i") { print $filename "[$image_types[$i]]\n"; } } } print $filename "
$cfont
\n"; } sub checkpersite { (my $url) = @_; if ($persite > 0 && @lines) { $FORM{'reply'} = 7; $FORM{'other'} = "I'm sorry, but your post was removed because I have limited\n"; $FORM{'other'} .= "the number of posts to $persite per site.\n"; $sites = 0; for ($i = 0; $i <= $#lines; $i++) { &getimage($i); if ($url eq $site_url) { $sites++; if ($sites > $persite) { &deleteone($i,0); $i--; } } } } } sub deleteone { (my $num, my $email_only) = @_; unless ($FORM{'reply'} == -1) { open (MAIL,"|$mailprogram -t"); print MAIL "To: $email\n"; print MAIL "From: $youremail\n"; print MAIL "Subject: Sorry\n"; &descimage; &defemail; print MAIL "$response[$FORM{'reply'}]\n"; if ($givestats && $FORM{'whichfile'} ne "approve") { &givestats; } if ($moreposts) { &mpemail; } &emailsig; close (MAIL); } $temp = ""; if ($FORM{$postnum.'delete_others'} == 1) { $temp = "9|$FORM{$postnum.'link_url'}"; } if ($FORM{$postnum.'delete_others'} == 2) { $temp = "5|$FORM{$postnum.'site_url'}"; } if ($FORM{$postnum.'delete_others'} == 3) { $temp = "6|$FORM{$postnum.'site_name'}"; } if ($FORM{$postnum.'delete_others'} == 4) { $temp = "7|$FORM{$postnum.'site_desc'}"; } if ($temp) { push(@others,$temp); } unless ($email_only == -1) { splice(@lines,$num,1); if ($index_num) { unlink("$postdir/$index_num$ex"); unlink("$datadir/c$index_num.txt"); unlink("$datadir/r$index_num.txt"); } } } sub defemail { $response[0] = "I'm sorry, but the picture that you attempted to post\n"; $response[0] .= "to my page at $mainurl did not meet my criteria,\n"; $response[0] .= "and therefor was not posted."; $response[1] = "I'm sorry, but your post to my page at $mainurl\n"; $response[1] .= "was not approved because I could not find the return\n"; $response[1] .= "link that I require. If you'd like to try again, please\n"; $response[1] .= "go to $scripturl"; $response[2] = "I'm sorry, but your post to my page at $mainurl\n"; $response[2] .= "was not approved because you did not use the required\n"; $response[2] .= "link syntax. The syntax is:\n\n$link\n\nPlease fix\n"; $response[2] .= "this and go to $scripturl to try again."; $response[3] = "I'm sorry, but your post to my page at $mainurl\n"; $response[3] .= "was not approved because the image you attempted to post\n"; $response[3] .= "was either not-existant or corrupted. If you'd like to\n"; $response[3] .= "try again, please go to $scripturl"; $response[4] = "I'm sorry, but your post was removed from my Pic-Post\n"; $response[4] .= "page at $mainurl because the image has changed in\n"; $response[4] .= "an unacceptable way. If you'd like to try again, go\n"; $response[4] .= "to $scripturl"; $response[5] = "I'm sorry, but your post was removed from my Pic-Post\n"; $response[5] .= "page at $mainurl because the image is now either corrupted\n"; $response[5] .= "or 404. If you'd like to try again, go to\n"; $response[5] .= "$scripturl"; $response[6] = "I'm sorry, but your post was removed from my Pic-Post\n"; $response[6] .= "page at $mainurl because I could not find the return\n"; $response[6] .= "link that I require. If you'd like to try again, go to\n"; $response[6] .= "$scripturl"; $response[7] = $FORM{'other'}; $temp = "because you tried to post your image to my\n"; $temp .= "$image_type section, and it clearly didn't belong there.\n"; $temp .= "If you'd like to try again, go to\n"; $temp .= "$scripturl"; $response[8] = "I'm sorry, but your post to my page at $mainurl\nwas not approved $temp"; $response[9] = "I'm sorry, but your post to my page at $mainurl\nwas removed $temp"; $response[10] = "I'm sorry, but your post was removed because you didn't\n"; $response[10] .= "send me enough hits.\n"; $response[11] = "I'm sorry, but your post was not approved because\n"; $response[11] .= "I couldn't find any links to the page where you\n"; $response[11] .= "said my return link was.\n"; $response[12] = "I'm sorry, but your post was removed because\n"; $response[12] .= "I couldn't find any links to the page where you\n"; $response[12] .= "said my return link was.\n"; $response[13] = "I believe the image was posted under another name.\n"; $response[13] .= "If you'd like to try again, go to\n$scripturl\n"; $response[14] = "I'm sorry, but your post was removed\n$response[13]"; $response[13] = "I'm sorry, but your post was not approved because\n$response[13]"; for ($i = 0; $i < 7; $i++) { $response[$i] .= "\n\nThanks for your time!\n"; } } sub givestats { open(FILE,"$datadir/c$index_num.txt"); my $temp = ; close(FILE); ($imp, $ctr) = split(/\|/, $temp); print MAIL "Here are some statistics to help you out the next time you\n"; print MAIL "post an image. Your image was viewed by a total of $imp\n"; print MAIL "people. The number of impressions is based mostly on the\n"; print MAIL "following things:\n"; print MAIL " * Your description of the image. This is what people click\n"; print MAIL " on to see your image.\n"; unless ($norate) { open(FILE,"$datadir/r$index_num.txt"); $temp = ; close(FILE); ($total, $votes, $junk) = split(/\|/, $temp); if ($votes) { $rating = sprintf("%.2f", $total / $votes); } else { $rating = 5; } print MAIL " * The quality of the image. The script I use allows surfers\n"; print MAIL " to rate images, and view them by rating. Your rating when\n"; print MAIL " your image was removed was $rating. This is on a scale of 1\n"; print MAIL " to 10. To get a basic idea of where that puts you, check out\n"; print MAIL " my rated page at $posturl/r0$ex\n"; } if ($link =~ /$counturl\?/) { open(FILE,"$datadir/l-main.txt"); my @temps = ; close(FILE); foreach $temp(@temps) { chomp($temp); ($ref,$filename) = split(/\|/,$temp); if ($ref eq $link_url) { open(FILE,"$datadir/l-$filename.txt"); $temp = ; close(FILE); ($count,$last) = split(/\|/,$temp); } } unless ($count) { $count = "0"; } print MAIL " * The quality of my return link. The script I use also allows\n"; print MAIL " me to list images by the ammount of traffic I receive from the\n"; print MAIL " link I require. Your site sent me $count hits.\n"; } print MAIL "\nOf the $imp people who saw your image, $ctr people clicked\n"; print MAIL "through to your page. This is based mostly on:\n"; print MAIL " * The quality of your image. If you post something that people\n"; print MAIL " like, they're a lot more likely to click through to your page.\n"; print MAIL " * The quality of your site name, description, and banner.\n\n"; } sub writedata { open (DATA, ">$datadir/setup.txt"); print DATA "$ex|$approval|$pptitle|$link|$youremail|$maxpics|$notify1|$notify2|$notify3|$bgcolor|$textcolor|$linkcolor|$alink|$vlink|$background|$keywords|$description|$return|$hw|$perpage|$head|$foot|$rules|$moreposts|$samedomain|$searchlink|$fontname|$type_of_link|$hw2|$default_listing|$posthead|$postfoot|$keepsearch|$persite|$givestats|$showhints|$eachrate|$checkapprove|$norate\n"; unless ($keepsearch) { unlink("$datadir/search.txt"); } for ($i = 0; $i <= $#image_types; $i++) { if ($i) { print DATA "|"; } print DATA "$image_types[$i]"; } close(DATA); } sub rotateout { if ($maxpics > 0 && $#lines >= $maxpics) { while($#lines >= $maxpics) { &getimage($#lines); if ($notify2) { open(MAIL,"|$mailprogram -t"); print MAIL "To: $email\n"; print MAIL "From: $youremail\n"; print MAIL "Subject: Your post has expired.\n"; &descimage; print MAIL "Unfortunately, I have limited the number of posts on\n"; print MAIL "my pic-post page to $maxpics, and your image was rotated\n"; print MAIL "out on $date at $time.\n\n"; if ($givestats) { &givestats; } if ($moreposts) { &mpemail; } &emailsig; close(MAIL); } if (-e "$postdir/$index_num$ex") { unlink("$postdir/$index_num$ex"); } if (-e "$datadir/c$index_num.txt") { unlink("$datadir/c$index_num.txt"); } if (-e "$datadir/r$index_num.txt") { unlink("$datadir/r$index_num.txt"); } splice(@lines,$#lines,1); } open(FILE,">$datadir/posts.txt"); foreach $line(@lines) { print FILE "$line"; } close(FILE); } } sub descimage { print MAIL "On $odate at $otime you posted an image to my pic-post page\n"; print MAIL "at $mainurl\n"; print MAIL "In case you don't remember, here's the information I have\n"; print MAIL "about the image you posted:\n\n"; if (@image_types) { print MAIL " * category: $image_type\n"; } print MAIL " * Image URL: $image_url\n"; print MAIL " * Description: $image_desc\n\n"; } sub emailsig { # Changing this sub, or any place where it is called is illegal. If you # really need to remove it, register the script at # http://www.shavenferret.com/scripts/register.shtml . It will cost a great # deal less than the lawsuit you'll face if you screw with this without # paying. print MAIL "\n****************************************************\n"; print MAIL "* If you can run perl scripts on your server and *\n"; print MAIL "* you can spare about half an hour to set *\n"; print MAIL "* everything up, you can get your own FREE *\n"; print MAIL "* Pic-Post page. Go to *\n"; print MAIL "* http://www.shavenferret.com/scripts/picpost *\n"; print MAIL "* to get everything you need! *\n"; print MAIL "****************************************************\n"; } sub rate { (my $which) = @_; print $which "