#!/usr/bin/perl
##############################################################################
#ProLinks
# Perl program by Stéphane Maltais #
# sublien Version 2.3 #
##############################################################################
# Define Variables
# Corrected
$basedir = "/home/stephm69/public_html/kayakdemer/liens";
$sublien_url = "http://www.kayakdemer.net/liens/sublien.pl";
$cgi_url = "http://www.kayakdemer.net/liens";
$baseurl = "http://www.kayakdemer.net/liens";
$mesgdir = "";
$datafile = "data2.txt";
$template = "ajout_lien_t.php";
$file_cat = "sous_cat.txt";
$file_sous_cat ="sous_cat.txt";
$faqfile = "faq.html";
$ajout_lien_vers="1.1";
$newlinksfile = "new_links.txt";
$background_im = "http://www.kayakdemer.net/background_lined.gif";
$ext = "html";
$title = "kayakdemer.net: Répertoire de liens";
# Done
###########################################################################
#&info("
L'ajout de liens est temporairement desactivé.
Merci de revenir soumettre votre lien plus tard.");
&get_info;
&get_variables;
&produire_page;
#######################
# Parse Form Subroutine
sub get_info {
local($name,$value);
# Get the input
$buffer = $ENV{'QUERY_STRING'};
# read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
$change = $buffer;
# Split the name-value pairs
@pairs = split(/&/, $change);
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
# Un-Webify plus signs and %-encoding
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# Remove any NULL characters, Server Side Includes
$value =~ s/\0//g;
$value =~ s///g;
if ($allow_html != 1) {
$value =~ s/<([^>]|\n)*>//g;
}
else {
unless ($name eq 'body') {
$value =~ s/<([^>]|\n)*>//g;
}
}
$FORM{$name} = $value;
}
}
###############
# Get Variables
sub get_variables
{
if ($FORM{'section'})
{
$section = "$FORM{'section'}";
}
if ($FORM{'reg_url'})
{
$reg_url = "$FORM{'reg_url'}";
}
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$month = ($mon + 1);
@months = ("Janvier","Février","Mars","Avril","Mai","Juin","Juillet","Août","Septembre","Octobre","Novembre","Decembre");
$year += 1900;
$long_date = sprintf("%02d %s %4d",$mday,$months[$mon],$year);
$year %= 100;
if ($use_time == 1) {
$date = sprintf("%02d:%02d:%02d %02d/%02d/%02d",$hour,$min,$sec,$month,$mday,$year);
}
else {
$date = sprintf("%02d/%02d/%02d",$month,$mday,$year);
}
}
#######################
# lire les sections
sub read_sections
{
open(MAIN,"$actu_dir/$cat_file") || die $!;
@cats = ;
close(MAIN);
$qt_sect=0;
foreach $catline (@cats)
{
($short_cat,$full_cat) = split(/\|/,$catline);
push(@sections,$short_cat,$full_cat);
%sections=@sections;
++$qt_sect;
}
}
###############################
# Écrire la page des catégories
sub produire_page
{
$atleastone = 0;
open(MAIN,"$basedir/$template") || die $!;
@main = ;
close(MAIN);
if ($section eq "base")
{
$actu_dir=$basedir;
$cats_dir=$file_cat;
}
else
{
$actu_dir="$basedir/$section";
$cats_dir=$file_sous_cat;
}
&get_fullsect;
open(MAIN,"$actu_dir/$cats_dir") || die $!;
@cats = ;
close(MAIN);
print "Content-type: text/html\n\n";
foreach $main_line (@main)
{
if ($main_line =~ //)
{
print " \n";
if($section ne "base")
{
print "< - Précédent
";
print "$fn_section\n";
print "
\n";
if($cats[0] ne "")
{
foreach $sous_cat (sort parnom @cats)
{
($short_scat,$full_scat) = split(/\|/,$sous_cat);
$ckcrossref = substr($full_scat, 0, 1);
if($ckcrossref eq '@')
{
$n_sous_cat_dir="$short_scat";
}
else
{
if($section eq "")
{
$n_sous_cat_dir="$short_scat";
}
else
{
$n_sous_cat_dir="$section/$short_scat";
}
}
if(!($reg_url))
{
if($atleastone == 0)
{
print "\n";
}
print "$full_scat
\n";
$atleastone = 1;
}
else
{
if($ckcrossref ne '@')
{
if($atleastone == 0)
{
print "\n";
}
print "$full_scat
\n";
$atleastone = 1;
}
}
}
if($atleastone == 1)
{
print"OU\n";
}
else
{
print "Aucune sous-catégorie
\n";
print"
\n";
}
}
else
{
print "Aucune sous-catégorie
\n";
print"
\n";
}
print"- Ajouter votre lien dans la section:
\n";
print"$fn_section
\n";
print"\n";
print "Suggérer une nouvelle sous-catégorie dans:
";
print "$fn_section
\n";
print "
\n";
}
else
{
print "Choisir une section
\n";
print "\n";
foreach $cat_name (sort parnom @cats)
{
($short_cat,$full_cat) = split(/\|/,$cat_name);
$ckcrossref = substr($full_cat, 0, 1);
if($ckcrossref eq '@')
{
($rshort_cat,$full_cat) = split(/\\/,$short_cat);
$n_cat_dir="$rshort_cat";
$n_fnsect="$full_cat";
}
else
{
$n_cat_dir="$short_cat";
$n_fnsect="$full_cat";
}
print "$full_cat
\n";
}
print "
\n";
print"
\n";
}
}
else
{
print "$main_line";
}
}
exit;
}
##############################
sub get_vals
{
open(NEWLINKS,"$basedir/$newlinksfile") || die $!;
@all_links_ru = ;
close(NEWLINKS);
foreach $lx (@all_links_ru)
{
@lx = split(/\|/,$lx);
if($lx[1] eq $reg_url)
{
$titre = $lx[0];
$url = $lx[1];
$description = $lx[2];
}
}
}
##############################
sub parnom
{
@a = split(/\|/,$a);
@b = split(/\|/,$b);
$a[1] =~ tr/A-Z/a-z/;
$a[1] =~ s/\@//g;
$a[1] =~ s/<[^>]*>//g;
$a[1] =~ s/é/e/g;
$a[1] =~ s/ê/e/g;
$a[1] =~ s/É/e/g;
$a[1] =~ s/Ê/e/g;
$a[1] =~ s/^l'//g;
$a[1] =~ s/ç/c/g;
$a[1] =~ s/Ç/C/g;
$a[1] =~ s/^le //g;
$a[1] =~ s/^la //g;
$a[1] =~ s/^les //g;
$b[1] =~ tr/A-Z/a-z/;
$b[1] =~ s/\@//g;
$b[1] =~ s/<[^>]*>//g;
$b[1] =~ s/é/e/g;
$b[1] =~ s/ê/e/g;
$b[1] =~ s/É/e/g;
$b[1] =~ s/Ê/e/g;
$b[1] =~ s/^l'//g;
$b[1] =~ s/ç/c/g;
$b[1] =~ s/Ç/C/g;
$b[1] =~ s/^le //g;
$b[1] =~ s/^la //g;
$b[1] =~ s/^les //g;
lc($a[1]) cmp lc($b[1]);
}
###################################################################
# Mettre complete section dans $fn_section
sub get_fullsect
{
# $actu_dir="$basedir/$section";
# $cats_dir=$file_sous_cat;
@fulldir = split(/\// , $section);
$base=1;
$fn_section=">>";
foreach $cat (@fulldir)
{
if($base==1)
{
open(MAIN,"$basedir/$file_cat") || die $!;
@cats = ;
close(MAIN);
$ndir="$basedir/$cat";
foreach $catline (@cats)
{
($short_cat,$full_cat) = split(/\|/,$catline);
push(@sections,$short_cat,$full_cat);
%sections=@sections;
}
$fn_section="$fn_section $sections{$cat}";
$submit_sect="$cat";
$base=0;
}
else
{
open(MAIN,"$ndir/$file_sous_cat") || die $!;
@cats = ;
close(MAIN);
$ndir="$ndir/$cat";
foreach $catline (@cats)
{
($short_cat,$full_cat) = split(/\|/,$catline);
push(@sections,$short_cat,$full_cat);
%sections=@sections;
}
$fn_section="$fn_section > $sections{$cat}";
$submit_sect="$submit_sect/$cat";
}
}
}
#################
# Debug info
sub info
{
$prntinfo = $_[0];
print "Content-type: text/html\n\n";
print "info: $prntinfo";
exit;
}