#!/sw/bin/perl #!/sw/bin/perl -w #use strict; ## ## Script to automatically insert hyperlinks to user pages ## into a web page via a registration form ## ## Copyright (C) 1996 - 1999 by Steffen Beyer ## ## ## Version history: ## ## Version Date Name What's new ## ------- -------- -------------------- ----------------------------------- ## 1.0.0 20.11.96 Steffen Beyer First release ## 1.1.0 21.11.96 Steffen Beyer Check for uniqueness, parametrized ## 1.1.1 19.10.99 Steffen Beyer Adjusted for brazilian professionals ## ## ## Global variables: ## my $notify = 'sb@engelschall.com'; my $domain = 'engelschall.com'; my $subject = 'Inscricao profissional brasileiro'; my $exception = ''; my $paragraph = ''; my $confirm = 0; my $self = $0; my $okay = 0; my @max = (); my @name = (); my @item = (); my @text = (); my @value = (); my @select = (); my @button = (); my %valid_name = (); my %valid_item = (); ## ## Configuration: ## sub init_config { my($i); $self =~ s!^.*/!!; $name[1] = 'name'; $max[1] = 40; $name[2] = 'mail'; $name[3] = 'text'; $max[3] = 80; $name[4] = 'link'; $name[5] = 'type'; $name[6] = 'okay'; for ( $i = 1; $i <= $#name; $i++ ) { $valid_name{$name[$i]} = $i; $value[$i] = ''; } $item[ 1] = 'fun'; $item[ 2] = 'cons'; $item[ 3] = 'publ'; $item[ 4] = 'tech'; $item[ 5] = 'food'; $item[ 6] = 'gast'; $item[ 7] = 'tour'; $item[ 8] = 'pres'; $item[ 9] = 'arte'; $item[10] = 'misc'; for ( $i = 1; $i <= $#item; $i++ ) { $valid_item{$item[$i]} = $i; $select[$i] = ''; } $text[ 1] = 'Lazer'; $text[ 2] = 'Consultas'; $text[ 3] = 'Entidades Públicas'; $text[ 4] = 'Equipamentos e Serviços Técnicos'; $text[ 5] = 'Produtos Alimentícios'; $text[ 6] = 'Gastronomia, Partyservice'; $text[ 7] = 'Agências de Turismo'; $text[ 8] = 'Mídia'; $text[ 9] = 'Arte'; $text[10] = 'Diversos'; $button[0] = 'Deixe-me ver como fica!'; $button[1] = 'Agora registre esse link!'; } ## ## Subroutines: ## sub process_data { my($i,$text,$sum,$max,$len,@now,$date); if (($value[1] ne '') && ($value[3] ne '') && ($value[5] > 0)) { $okay = 1; $confirm = 1; } foreach $i (1, 3) { next if (length($value[$i]) <= $max[$i]); $okay = 0; $text = $value[$i]; $value[$i] = ''; $sum = 0; while ($sum < $max[$i]) { $max = $max[$i] - $sum; if ($text =~ m!(&[a-zA-Z][a-z]+;)!) { $text = $'; $len = length($`); if ($len >= $max) { $value[$i] .= substr($`, 0, $max); $sum += $max; } else { $value[$i] .= $` . $1; $sum += ++$len; } } else { $value[$i] .= substr($text, 0, $max); $sum += $max; } } } @now = (localtime())[3,4,5,2,1,0]; $now[1]++; $now[2] %= 100; $date = sprintf("%02d.%02d.%02d %02d:%02d:%02d", @now); $paragraph = qq,\n,; if ($value[2] ne '') { $text = $value[2]; if ($text !~ m!^[a-zA-Z]+:!) { $text = "mailto:$text"; } $paragraph .= qq,$value[1]\n,; } else { $paragraph .= qq,$value[1]\n,; } $paragraph .= qq,\n,; if ($value[4] ne '') { $text = $value[4]; if ($text !~ m!^[a-zA-Z]+://!) { $text = "http://$text"; } $paragraph .= qq,$value[3]\n,; } else { $paragraph .= qq,$value[3]\n,; } $paragraph .= qq,\n$date\n,; $select[$value[5] || $#item] = ' SELECTED'; } sub get_input { my(@pairs,$pair,$var,$val,$n,$k); # $ENV{'QUERY_STRING'} = 'name=a&mail=b&text=c&link=d&type=gast'; # $ENV{'QUERY_STRING'} = 'name=a&mail=b&text=c&link=d&type=fun&okay=1'; @pairs = split(/&/, $ENV{'QUERY_STRING'}); foreach $pair (@pairs) { ($var, $val) = split(/=/, $pair); # $val =~ s/%E4/ae/g; # $val =~ s/%C4/Ae/g; # $val =~ s/%F6/oe/g; # $val =~ s/%D6/Oe/g; # $val =~ s/%FC/ue/g; # $val =~ s/%DC/Ue/g; # $val =~ s/%DF/ss/g; $val =~ s/\+/ /g; $val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $val =~ s/"/"/g; $val =~ s/^\s+//; $val =~ s/\s+$//; $val =~ s/\s+/ /g; unless ($n = $valid_name{$var}) { $exception = "Os parametros contêm um nome de campo desconhecido!"; return 0; } if ($n == 5) { if ($k = $valid_item{$val}) { $value[$n] = $k; # avoid "eval" with unsafe $val! } else { $exception = "Os parametros contêm uma categoria desconhecida!"; return 0; } } else { $value[$n] = $val; # avoid "eval" with unsafe $val! } } &process_data; return 1; } sub print_form { my($i); print <<"VERBATIM"; Content-type: text/html; charset="iso-8859-1" Registre aqui você mesmo o seu próprio link!

Registre aqui você mesmo o seu próprio link!

Seu nome completo: (no máximo $max[1] caráteres)
Seu endereço e-mail: (por exemplo "fulano\@mail.scumbal.com")
Descrição da sua área de trabalho / homepage: (no máximo $max[3] caráteres)
Endereço da sua homepage: (por exemplo "www.scumbal.com/meu/negocio.html")
Escolha a categoria em que deve aparecer o seu link!

VERBATIM if ($confirm) { print <<"VERBATIM"; O seu link aparecerá da forma seguinte:

$paragraph

(Para corrigir é recomendado voltar para a página anterior) VERBATIM } else { print <<"VERBATIM"; Ajuda: 
á = &aacute;
é = &eacute;
í = &iacute;
ó = &oacute;
ú = &uacute;

Á = &Aacute;
É = &Eacute;
Í = &Iacute;
Ó = &Oacute;
Ú = &Uacute;

â = &acirc;
ê = &ecirc;
ô = &ocirc;
º = &ordm;
ª = &ordf;

 = &Acirc;
Ê = &Ecirc;
Ô = &Ocirc;
" = &quot;
& = &amp;

à = &agrave;
ã = &atilde;
õ = &otilde;
ü = &uuml;
ç = &ccedil;

À = &Agrave;
à = &Atilde;
Õ = &Otilde;
Ü = &Uuml;
Ç = &Ccedil;
(Contam todos como um só caráter) VERBATIM } print <<"VERBATIM";

Por favor verifique bem todos os seus dados antes de registrá-los,
pois esse programa não tem nenhuma possibilidade de validá-los,
e não tem a possibilidade de apagar uma entrada uma vez que ela foi registrada,
a não ser através de um e-mail para o administrador!

VERBATIM } sub print_error { print <<"VERBATIM"; Content-type: text/html; charset="iso-8859-1" Erro na registração automática

Erro na registração automática:

$exception

VERBATIM } sub print_success { print <<"VERBATIM"; Content-type: text/html; charset="iso-8859-1" Registração automática

Registração automática

A inserção do seu link na categoria

"$text[$value[5]]"

foi bem-sucedida:

$paragraph

VERBATIM } sub insert_page { my($flag,$match,$i,$file); $flag = 0; $match = '('; for ( $i = 1; $i <= 4; $i++ ) { if ($value[$i] ne '') { if ($flag) { $match .= '|'; } $match .= quotemeta($value[$i]); $flag = 1; } } $match .= ')'; $file = "../txt/$item[$value[5]].txt"; unless (-f $file) { $exception = "Erro interno: O arquivo '$file' não existe!"; return 0; } if ($flag) { unless (open(READ, "<$file")) { $exception = "Erro interno: Não consigo ler o arquivo '$file': $!"; return 0; } while() { if (/$match/io) { close(READ); $exception = qq,A entrada

"$1"

já existe na categoria

"$text[$value[5]]"!,; return 0; } } unless (close(READ)) { $exception = "Erro interno: Não consigo fechar o arquivo '$file': $!"; return 0; } } # if (-e "$file.bak") # { # $exception = "Erro interno: O arquivo '$file.bak' já existe!"; # return 0; # } # unless (rename($file, "$file.bak")) # { # $exception = "Erro interno: Não consigo mudar o nome do arquivo '$file' para '$file.bak': $!"; # return 0; # } unless (open(PIPE, "| /sw/bin/sendmail -t")) { $exception = "Erro interno: Não consigo abrir o pipe: $!"; return 0; } $i = (getpwuid($<))[0]; print PIPE <<"VERBATIM"; From: $i\@$domain Reply-To: $notify To: $notify Subject: $subject X-Sender: $0 $paragraph VERBATIM unless (close(PIPE)) { $exception = "Erro interno: Não consigo fechar o pipe: $!"; return 0; } unless (open(WRITE, ">>$file")) { $exception = "Erro interno: Não consigo escrever para o arquivo '$file': $!"; return 0; } print WRITE "$paragraph\n\n"; # unless (open(READ, "<$file.bak")) # { # close(WRITE); # $exception = "Erro interno: Não consigo ler o arquivo '$file.bak': $!"; # return 0; # } # while () # { # print WRITE; # } # unless (close(READ)) # { # close(WRITE); # $exception = "Erro interno: Não consigo fechar o arquivo '$file.bak': $!"; # return 0; # } unless (close(WRITE)) { $exception = "Erro interno: Não consigo fechar o arquivo '$file': $!"; return 0; } # if (unlink("$file.bak") != 1) # { # $exception = "Erro interno: Não consigo apagar o arquivo '$file.bak': $!"; # return 0; # } return 1; } ## ## Main: ## &init_config; if (&get_input) { if ($okay && $value[6]) { if (&insert_page) { &print_success; } else { &print_error; } } else { &print_form; } } else { &print_error; } __END__