Язык
Контакты
GitHub
Поддержка
Регистрация
Войти
Логин: Пароль: Запомнить:
Пользователи
Последние сообщения
Ответить
1 2

Всякие приятности

Drunya

  • Man of God
  • Админ
  • 3527
  • Репутация:110 
  • Предупреждения: 0 
  • Регистрация:
    30 Ноя -0001
#1
если в строке есть урл то возвращает html гиперссылку на него

Code:
sub chehttp {
my $str_with_http = shift;
$str_with_http =~ s/(http:\/\/[\w,\.,\-,\&,\/,\~]+)/\<a href=\"$1\"\>$1\<\/a\>/ig;
return $str_with_http;
}
если в строке есть email то возвращает html гиперссылку на него
Code:
sub chemail {
my $str_with_mail = shift;
$str_with_mail =~ s/([\w,\-,\.]+\@[\w,\-,\.]+\.\w{2,4})/\<a href=\"mailto:$1\"\>$1\<\/a\>/g;
return $str_with_mail;
}


Проверка почтового адреса на стоп символы
Code:
sub mailstop {
   my $stopmail=shift;
   # есть стоп символы (1) !!!
   if ($stopmail=~ tr/\/\\\+=~;<>*|`&$!#()[]{}:'" //) {return 1} else {return 0}
}
удаление символов перевода каретки для WinNT&Unix кодировок
Code:
sub chdel {my $chdel_mem=shift; $chdel_mem=~ s/[\x0D\x0A]//g; return $chdel_mem}
Перекодировщик win <-> koi <-> iso <-> dos
$str=encoder($str,"win","dos");
$str=encoder($str,"dos","uc");
$str=encoder($str,"dos","lc");
Code:
sub encoder {
my ($enstring,$cfrom,$cto)=@_;
my %codefunk=(
win=>"\xC0\xC1\xC2\xC3\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0\xD1\xD2\xD3\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xDB\xDC\xDD\xDE\xDF\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF\xF0\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA\xFB\xFC\xFD\xFE\xFF",
koi=>"\xE1\xE2\xF7\xE7\xE4\xE5\xF6\xFA\xE9\xEA\xEB\xEC\xED\xEE\xEF\xF0\xF2\xF3\xF4\xF5\xE6\xE8\xE3\xFE\xFB\xFD\xFF\xF9\xF8\xFC\xE0\xF1\xC1\xC2\xD7\xC7\xC4\xC5\xD6\xDA\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0\xD2\xD3\xD4\xD5\xC6\xC8\xC3\xDE\xDB\xDD\xDF\xD9\xD8\xDC\xC0\xD1",
iso=>"\xB0\xB1\xB2\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xBB\xBC\xBD\xBE\xBF\xC0\xC1\xC2\xC3\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0\xD1\xD2\xD3\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xDB\xDC\xDD\xDE\xDF\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF",
dos=>"\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8A\x8B\x8C\x8D\x8E\x8F\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9A\x9B\x9C\x9D\x9E\x9F\xA0\xA1\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9\xAA\xAB\xAC\xAD\xAE\xAF\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF",

koi_lc=>"tr/\xB3\xE0-\xFF/\xA3\xC0-\xDF/", koi_uc=>"tr/\xA3\xC0-\xDF/\xB3\xE0-\xFF/",
win_lc=>"tr/\xA8\xC0-\xDF/\xB8\xE0-\xFF/", win_uc=>"tr/\xB8\xE0-\xFF/\xA8\xC0-\xDF/",
alt_lc=>"tr/\xF0\x80-\x9F/\xF1\xA0-\xAF\xE0-\xEF/", alt_uc=>"tr/\xF1\xA0-\xAF\xE0-\xEF/\xF0\x80-\x9F/",
iso_lc=>"tr/\xA1\xB0-\xCF/\xF1\xD0-\xEF/", iso_uc=>"tr/\xF1\xD0-\xEF/\xA1\xB0-\xCF/",
dos_lc=>"tr/\x80-\x9F/\xA0-\xAF\xE0-\xEF/", dos_uc=>"tr/\xA0-\xAF\xE0-\xEF/\x80-\x9F/",
mac_lc=>"tr/\xDD\x80-\xDF/\xDE\xE0-\xFE\xDF/", mac_uc=>"tr/\xDE\xE0-\xFE\xDF/\xDD\x80-\xDF/"
);

if (!$enstring or !$cfrom or !$cto) {return ''}
else {
   if ($cfrom ne "" and $cto ne "lc" and $cto ne "uc") {
      $_=$enstring;$cfrom=$codefunk{$cfrom};$cto=$codefunk{$cto};
      eval "tr/$cfrom/$cto/"; return $_;
   }
   elsif (($cfrom ne "") and ($cto eq "lc" or $cto eq "uc")) {
      $_=$enstring; $cfrom=$codefunk{"$cfrom\_$cto"};
      eval $cfrom; return $_;
   }
}
return $enstring;
}

полный путь до скрипта (нужно для вставки пути в формы):
Code:
$ScrHost=$ENV{'HTTP_HOST'};
$ScrName=$ENV{'SCRIPT_NAME'};
($ScrName, $ScrName1) = split(/\?/, $ScrName);
$ScrFullPath="$ScrHost$ScrName";
$ScrFullPatha=substr($ScrFullPath, 0, 7);
$ScrFullPatha=~tr/a-z/A-Z/;
if ($ScrFullPatha ne 'HTTP://'){$ScrFullPath="http://$ScrFullPath";}
Расставление ссылок): как вариант
Code:
sub proLinker{
my $text = shift;
$text =~ s~([^\w\"\=\[\]]|[\A\n\b])\\*(\w+://[^<>\s\n\"\]\[]+)~$1<a href="$2" target="_blank">$2</a>~isg;
$text =~ s~([^\"\=\[\]/\:]|[\A\n\b])\\*(www\.[^<>\s\n\]\[]+)~$1<a href="http://$2" target="_blank">$2</a>~isg;
$text =~ s~([^\f\"\=\[\]]|[\A\n\b])\\*(\f+://[^<>\s\n\"\]\[]+)~$1<a href="$2" target="_blank">$2</a>~isg;
$text =~ s~([^\"\=\[\]/\:]|[\A\n\b])\\*(ftp\.[^<>\s\n\]\[]+)~$1<a href="ftp://$2" target="_blank">$2</a>~isg;
$text =~ s~(\S+?)\@(\S+)~<a href="mailto:$1\@$2">$1\@$2</a>~isg;
return $text;
}
Замена тегов
Code:
sub htmlEncode {
my $text = shift;

$text =~ s!&!&amp;!g;
$text =~ s!>!&gt;!g;
$text =~ s!<!&lt;!g;
$text =~ s!\"!&quot;!g;

return $text;
}


Квотим HTML:
Code:
sub unHTML {
my $text = shift;
my %ENT=('<'=>'lt','>'=>'gt','"'=>'quot');
$text =~ s!([<>"])!&$ENT{$1};!g;
$text =~ s|<!--|<!--|g;
$text =~ s|-->|-->|g;
$text =~ s|<script>|<script>|ig;
$text =~ s|  | &nbsp;|g;
$text =~ s|^\$+$|&#36|g;
$text =~ s|\@|@|g;
$text =~ s!\|!|!g;
$text =~ s|\{|{|g;
$text =~ s|\}|}|g;
$text =~ s|\\,|,|g;
$text =~ s|\~|~|g;
$text =~ s|'|'|g;
$text =~ s|\n|<br>|g;
$text =~ s|\s+$||g;
$text =~ s|\$|&#36|g;
$text =~ s|\r||g;
$text =~ s!\\!\!g;

return $text;
}
И обратная процедура:
Code:
sub doHTML {
my $text = shift;

$text =~ s/@/\@|g;
$text =~ s/'/'/g;
$text =~ s/\&lt;/</g;
$text =~ s/\&gt;/>/g;
$text =~ s!&#36!\$!g;
$text =~ s/|/\|/g;
$text =~ s/+/\+/g;
$text =~ s/*/\*/g;
$text =~ s/)/\)/g;
$text =~ s/(/\(/g;
$text =~ s/,/,/g;
$text =~ s/}/\}/g;
$text =~ s/{/\{/g;
$text =~ s/\/\\/g;
$text =~ s/&quot;/"/g;
$text =~ s/&amp;/&/g;

return $text;
}

Сортировка строк по полям, разделенным символом.
Например, хочу отсортировать строки, разделенные на поля запятой,

Code:
sub fieldsort {
           my ($sep, $cols);
           if (ref $_[0]) {
               $sep = '\\s+'
           } else {
               $sep = shift;
           }
           unless (ref($cols = shift) eq 'ARRAY') {
               die "fieldsort columns must be in anon array";
           }
           my (@sortcode, @col);
           my $col = 1;
           for (@$cols) {
               my ($a, $b) = /^-/ ? qw(b a) : qw(a b);
               my $op = /n$/ ? '<=>' : 'cmp';
               push @col, (/(\d+)/)[0] - 1;
               push @sortcode, "\$${a}->[$col] $op \$${b}->[$col]";
               $col++;
           }
           my $sortfunc = eval "sub { " . join (" or ", @sortcode) . " } ";
           my $splitfunc = eval 'sub { (split /$sep/o, $_)[@col] } ';
           return
               map $_->[0],
               sort { $sortfunc->() }
               map [$_, $splitfunc->($_)],
               @_;
       }

Примеры:
сначала по второму полю по числам, затем по первому полю по алфавиту в порядке убывания.
@sorted = fieldsort ':', ['2n', -1], @data;
по 2-му затем по 1-му

Я горжусь тем, что создал бесплатную CMS - AtomX. И люблю нашу команду)

rest

  • Заглянувший
  • Юзер
  • 17
  • Репутация:0 
  • Предупреждения: 0 
  • Регистрация:
    6 Окт 2010
#2
О Господи)) Перл это кошмар, пусть и пошустее PHP gg)

Drunya

  • Man of God
  • Админ
  • 3527
  • Репутация:110 
  • Предупреждения: 0 
  • Регистрация:
    30 Ноя -0001
#3
Кого-то от него прет. Даже движки пишут. хотя лично я тоже этого не представляю %)

Я горжусь тем, что создал бесплатную CMS - AtomX. И люблю нашу команду)

skad0

  • Атом-мозг
  • Юзер
  • 841
  • Репутация:10 
  • Предупреждения: 0 
  • Регистрация:
    2 Окт 2010
#4
а как вообще перл использовать?

Drunya

  • Man of God
  • Админ
  • 3527
  • Репутация:110 
  • Предупреждения: 0 
  • Регистрация:
    30 Ноя -0001
#5
да так же как и пыху. Схожий язык, только файлы с другим расширением и сервер должен естественно поддерживать перл:)

Я горжусь тем, что создал бесплатную CMS - AtomX. И люблю нашу команду)

skad0

  • Атом-мозг
  • Юзер
  • 841
  • Репутация:10 
  • Предупреждения: 0 
  • Регистрация:
    2 Окт 2010
#6
блооо. перл - набор корявых операторов, в который собрали кучу плюшек с других языков

Drunya

  • Man of God
  • Админ
  • 3527
  • Репутация:110 
  • Предупреждения: 0 
  • Регистрация:
    30 Ноя -0001
#7
:D По крайне мер, те скрипты, что мне доводилось видеть, наводили на меня ужас)

Я горжусь тем, что создал бесплатную CMS - AtomX. И люблю нашу команду)

Leoparde

  • Заглянувший
  • Юзер
  • 21
  • Репутация:1 
  • Предупреждения: 0 
  • Регистрация:
    2 Апр 2011
#8
Drunya, ничего подобного. Потихоньку учу его, и страха он не вызывает. У меня и коды юкоза когда то давно страх вызывали))) Он похож на пыху, сильно

ARMI

  • Заклинатель Атома
  • Пользователь
  • 1858
  • Репутация:46 
  • Предупреждения: 0 
  • Регистрация:
    4 Янв 2011
#9
та кодов юкоза щас в любом уголке инета :D
Меня перл тоже устрашает)

Я горжусь тем, что помогаю в развитии бесплатной CMS - AtomX

Drunya

  • Man of God
  • Админ
  • 3527
  • Репутация:110 
  • Предупреждения: 0 
  • Регистрация:
    30 Ноя -0001
#10
Но у Perl есть и преимущества перед PHP. Если не ошибаюсь, он быстрее. И всякие высоко нагруженные проекты клепают именно на нем)

Я горжусь тем, что создал бесплатную CMS - AtomX. И люблю нашу команду)
1 2
Сейчас online: 36. Зарегистрированных: 2. Гостей: 34.