VPF::Ссылки в скриптах - Форум программистов

Xeim

Дата 26.1.2006, 10:44 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 186
Регистрация: 17.11.2005

Репутация: нет
Всего: 0

У меня такая трабла появилась:
На моем сайте в гостевой книге можно написать свою домашнюю страничку. Но я никак не могу придумать, как мне сделать обработку вводимого текста в ссылку. smile

Если в поле для заполнения писать сайт с "http://", то все норма, а если без, то ссылка открывается неправильно. Тогда я стал добавлять к сайту http:// через скрипт, и попросил писать в гостевухе сайты без http:// , но все рано многие пишут с ним.
Так вот: я в perl'е не силен, помогите написать часть скрипта так, чтобы любой способ записи приводился к виду http(ftp)://***.***.***/***.

Вот, часть скрипта моей гостевухи:

Код


<HR><FORM action="guestbook.cgi" METHOD="POST">
<TABLE border=0>
<TR><TD>Имя:</TD><TD colspan=3><INPUT NAME="Name"></TD></TR>
<TR><TD>E-mail:</TD><TD colspan=3><INPUT NAME="Email"></TD></TR>
[b]<TR><TD>Домашняя страничка:</TD><TD colspan=3><INPUT NAME="URL"></TD></TR>[/b]
<TR><TD>Сообщение:</TD><TD colspan=3><TEXTAREA NAME="Message" rows=6 cols=64></TEXTAREA></TD></TR>
<TR><TD>Настроение:</TD><TD><IMG src="$Mailgifs[0]"></TD><TD><IMG src="$Mailgifs[1]"></TD><TD><IMG src="$Mailgifs[2]"></TD></TR>
<TR><TD> </TD><TD><INPUT TYPE="radio" NAME="Mood" VALUE="$Mailgifs[0]" checked></TD>
                   <TD><INPUT TYPE="radio" NAME="Mood" VALUE="$Mailgifs[1]"></TD>
                   <TD><INPUT TYPE="radio" NAME="Mood" VALUE="$Mailgifs[2]"></TD></TR>
<TR><TD colspan=4><INPUT TYPE="submit" VALUE="Отослать"></TD>
</TR>
</TABLE></FORM>
<HR><BR>
HTML_generating
  open DATAFILE,"$datafile"|| die "Cannot open $datafile $!\n";
  @GUESTDATA=<DATAFILE>;
  print @GUESTDATA;
  close DATAFILE;
  print "</BODY></HTML>";
  }
else{
  foreach(@fields=split(/&/,$query)){
    if(/^Name=(.*)/){$Name=&urldecode($1);}
    if(/^Email=(.*)/){$Email=&urldecode($1);}
    [b]if(/^URL=(.*)/){$URL=&urldecode($1);}[/b]
    if(/^Message=(.*)/){$Message=&urldecode($1);}
    if(/^Mood=(.*)/){$Mood=&urldecode($1);}
    }
  $MESSAGE=&strhtm($Message);
  if(-e $datafile){unless (-r $datafile && -w $datafile){die "Cannot access $datafile\n";}}
  $Newmsg="<font>$dat</font><br><br><IMG src=\"$Mood\"><BR><A href =\"mailto:$Email\">$Name</A>".
         [b] "(<A href=\"$URL\" target='_blank'>$URL</A>):<BR>\n$MESSAGE<HR>\n";[/b]
  open DATAFILE,"+<$datafile" || die "Cannot open $datafile $!\n";
  @GUESTDATA=<DATAFILE>;
  @GUESTDATA=($Newmsg,@GUESTDATA);
  seek(DATAFILE,0,0);
  print DATAFILE @GUESTDATA;
  close DATAFILE;

ЗЫ Строки, где адрес обрабатывается я выделил.

Это сообщение отредактировал(а) korob2001 - 26.1.2006, 11:14

chaos

Дата 26.1.2006, 11:43 (ссылка)

(нет голосов)

Загрузка ...

Серийный программист

Профиль
Группа: Завсегдатай
Сообщений: 2979
Регистрация: 7.7.2004
Где: Екатеринбург

Репутация: 6
Всего: 44

самый наверное простой вариант сделать как-нибудь так

Код


$s = "123e1.ru";

if ($s !~ m|http://|)
{
    $s =~ s/^[^\w\d]+//;
    $s = 'http://' . $s: 
}
print $s;

Это сообщение отредактировал(а) chaos - 26.1.2006, 11:48

Xeim

Дата 26.1.2006, 14:19 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 186
Регистрация: 17.11.2005

Репутация: нет
Всего: 0

А можно поподробнее? Я плохо знаю Перл! smile

sharq

Дата 27.1.2006, 09:26 (ссылка)

(нет голосов)

Загрузка ...

Perl Liker

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 13.12.2004
Где: Ростов-на-Дону

Репутация: 23
Всего: 28

Xeim на самом деле, нужно обрабатывать поле с домашней страничкой так:
если есть символ ://, то оставляешь такое поле в покое,
если нет, то добавляй http://.

Код


$URL = 'http://'.$URL unless $URL =~ m{://};

--------------------

[color=gray]There's More Than One Way To Do It[/color]

Xeim

Дата 27.1.2006, 16:22 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 186
Регистрация: 17.11.2005

Репутация: нет
Всего: 0

Спасибо!

Будут непонятки спрошу!

Xeim

Дата 9.2.2006, 19:00 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 186
Регистрация: 17.11.2005

Репутация: нет
Всего: 0

Блин, че-то не получаицца...
Упросим задачу: есть переменная $url, которая получилась после обработки вводимого юзером текта вот етой функцией:

Код


sub urldecode{
 local($val)=@_;
 $val=~s/\+/ /g;
 $val=~s/%([0-9A-H]{2})/pack('C',hex($1))/eg;
 return $val;
 }

Юзер мог написать сайт как с 'http://' так и без него, так вот: напишите кто-нить как сделать так, чтоб, если он был написан без 'http://', то 'http://' приписывался.
ЗЫ То, что предложил m-k по сути то, что мне надо, только браузер пишет, что ошибка в скрипте.

korob2001

Дата 9.2.2006, 22:56 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2871
Регистрация: 29.12.2002

Репутация: 31
Всего: 61

Попробуй так:

Код


#!/usr/bin/perl -w
use strict;

# Протоколы которые будем принимать, по умолчанию http, https, ftp
my $access_proto  = qr/http|ftp|https/;
# Если протокол не указан, то будем вставлять следующий
my $default_proto = "http";

# Просто массив с url, только для теста
my @urls = ("http://yandex.ru",
            "https://security.org",
            "ftp://public/myftp",
            "www.yahoo.com",
            "file://Documents/My/Local/Files/index.html",
            "linux.org");



# Подпрограмма получает url, если его протокол не допустим или не указан то,
# изменяет его на тот, который установлен по умолчанию, в нашем случае это http
sub urlControl {
    my $url = shift;
    my $proto = "";
    $url =~ s/^(?:([a-z]{3,5})\:\/\/)?(.*)$/$2/ei;
    $proto = lc($1);
    $proto = $default_proto if $proto !~ /^$access_proto$/o;
    return $proto . "://$url";
}

# Проходим по всему массиву и выводим уже исправленные url
print urlControl($_)."\n" foreach @urls;

Зы: я особо не тестировал код выше, потому потестируй сам с различными протоколами.

Это сообщение отредактировал(а) korob2001 - 9.2.2006, 23:00

--------------------

"Время проходит", - привыкли говорить вы по неверному пониманию.
"Время стоит - проходите вы".

sharq

Дата 10.2.2006, 11:12 (ссылка)

(нет голосов)

Загрузка ...

Perl Liker

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 13.12.2004
Где: Ростов-на-Дону

Репутация: 23
Всего: 28

Xeim

Цитата(Xeim @ 9.2.2006, 20:00

)

ЗЫ То, что предложил m-k по сути то, что мне надо, только браузер пишет, что ошибка в скрипте.

Если ошибка 500, то привиди лог ошибки, посмотрим.

Вариант, который я привел, самый простой и работающий.
Потестируй сам - вот такой пример:

Код


use strict;

my $URL = 'http://www.ya.ru'; # попробуй так, потом без http://
$URL = 'http://'.$URL unless $URL =~ m{://};

print "Content-type: text/html\n\n"; # если будешь запускать через браузер
print $URL, "\n";

--------------------

[color=gray]There's More Than One Way To Do It[/color]

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: Общие вопросы \| Следующая тема »