Перейти из форума на сайт.


Система IP-видеонаблюдения "Линия". Скачать бесплатную демо-версию для 16 камер. НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Интернет » Web-программирование » Perl: Полезные решения

Модерирует : Cheery

 Версия для печати • ПодписатьсяДобавить в закладки
Страницы: 1 2 3 4 5 6 7 8

Открыть новую тему     Написать ответ в эту тему

Anton_Y



Full Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Итак.. Предлагаю создать на форуме топик где будут размещатся различные решения различных задач (типа библиотека функций).
Размещать рекомендуется с описанием (что этот код делае), с описанием переменных (желательно use strict)
p.s. размещать не обязательно свои исходники..  
мой скомный вклад.. (что сумел вспомнить:) )
 
  • исключение из массива повторяющихся записей (аналог distinct в sql) Подробнее...
  •  рекурсивный обход папок Подробнее...
  • Исключение из массива данных встречающихся в другом массиве Подробнее...
  • Perl: Перекодировка кириллического текста (win/koi/iso/utf)
  • Приведение регистра текста к нормально виду Подробнее...
  • Замена строки (выражения) в большом количестве файлов на другое Подробнее...
     
     
     
    p.s. для профи конечно это капля в море, но для новичков своеобразный faq. И предлагаю эту тему приклеить, чтобы она всегда была вверху..
    p.p.s. и постите свои фишки сюда..  

    Никаких вопросов! Только решения!

     
    Perl Cookbook on-line http://pleac.sourceforge.net/pleac_perl/index.html  
    DevShed Perl Articles http://www.devshed.com/c/a/Perl/

  • Всего записей: 578 | Зарегистр. 04-09-2002 | Отправлено: 07:12 14-07-2004 | Исправлено: Cheery, 23:38 01-03-2008
    Kokoc

    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Вот еще парочка полезных от меня:
     
    Проверка ИНН

    Код:
     
    sub CheckINN {
      my $inn = shift @_;
      my @mno = (3, 7, 2, 4, 10, 3, 5, 9, 4, 6, 8);
      my $cnt=0;
      my $newinn;
      return 0 if(length($inn)!=10 and length($inn)!=12);
      if(length($inn) == 10 ) {
        @mno=splice(@mno,2,9);
        for(0..8) {   $cnt+=substr($inn,$_,1)*$mno[$_];   }
        $newinn = substr($inn,0,9).(($cnt%11)%10);
     } else {    
        my $cnt1=0;
        for(0..10) {  $cnt1+=substr($inn,$_,1)*$mno[$_];  }
        @mno=splice(@mno,1,10);
        for(0..9)  {  $cnt+=substr($inn,$_,1)*$mno[$_];   }
        $newinn = substr($inn,0,10).(($cnt%11)%10).(($cnt1%11)%10);
      }
    #  print "INN: $inn  NEWINN: $newinn ";
      return ($inn eq $newinn);
    }
     

     
    Проверка ОГРН (только юридические лица)

    Код:
     
    sub CheckOGRN
    {
      my $ogrn = shift @_;
      return 0 if(length($ogrn)!=13 ||
        ((substr($ogrn,0,12)%11)%10) != substr($ogrn,12,1));
      return 1;
    }
     

    Всего записей: 793 | Зарегистр. 06-06-2002 | Отправлено: 17:24 24-01-2005
    cr4k3r



    Junior Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    2kokos:
    Вот от меня:
    Сумма прописью
     
    а вы пробовали так:
     
    print propis(100023),"\n";
     
    пишет:
     
    Use of uninitialized value in concatenation (.) or string at prop.pl line 45.
     ТЫСЯЧ ДВАДЦАТЬ ТРИ РУБЛЯ 00 КОПЕЕК
     
    Доработочки требует функция

    Всего записей: 80 | Зарегистр. 27-10-2004 | Отправлено: 19:07 25-01-2005
    Anton_Y



    Full Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    print my $text=propis (13224),"\n";

    ----------
    Чаще всего меня можно найти на форуме famaclamosa.com
    и самое главное (!) - Мой хостер - hosteam.ru

    Всего записей: 578 | Зарегистр. 04-09-2002 | Отправлено: 20:42 25-01-2005
    cr4k3r



    Junior Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    print my $text=propis (13224),"\n"; -  по вашему это важно???
    дело в числе. при поступлении которого получается ->  Use of uninitialized value in concatenation (.) or string at prop.pl line 45.

    Всего записей: 80 | Зарегистр. 27-10-2004 | Отправлено: 11:03 26-01-2005
    Kokoc

    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    cr4k3r
    Точно глюк!
     
    Надо после строки  
    $yy[9]="ДЕВЯНОСТО";
    добавить
    $yy[10]="СТО";
     

    Всего записей: 793 | Зарегистр. 06-06-2002 | Отправлено: 20:25 26-01-2005
    cr4k3r



    Junior Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Ага! Теперь норма. Полезная функция - особенно для бухгалтерии )

    Всего записей: 80 | Зарегистр. 27-10-2004 | Отправлено: 10:48 27-01-2005
    CheRt



    Advanced Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Ф-ция аналог CGI::param
    Немного не дооптимизированная, но тем не менее:

    Код:
     
    sub get_params {
     local ($i,$buf,@data);
     local $maxsize=1024*8;
     
     if (length($ENV{'CONTENT_LENGTH'})<=$maxsize) {
      read(STDIN,$buf,$ENV{'CONTENT_LENGTH'});
     
      @data=split(/&/,$buf);
      foreach $i (0 .. $#data) {  
       @_=split(/=/,$data[$i]);
       $_[0]=~s/%(..)/pack("c",hex($1))/ge;
       $_[1]=~s/%(..)/pack("c",hex($1))/ge;
       $param{$_[0]}=$_[1];
      }
     }
     
     $buf=$ENV{'QUERY_STRING'};  
     
     @data=split(/&/,$buf);
     foreach $i (0 .. $#data) {  
      @_=split(/=/,$data[$i]);
      $_[0]=~s/%(..)/pack("c",hex($1))/ge;
      $_[1]=~s/%(..)/pack("c",hex($1))/ge;
      $param{$_[0]}=$_[1];
     }
     
     ($i,@data,$buf,$maxsize,@_)=();
    }
     

     
    Читает с GET и POST одновременно. Создает глобальный хеш парамметров %param, в который и записывает полученную инфу. Если на посте и гете будут запросы с одинаковыми ключами, то перекроет значение ГЕТ метод!

    ----------
    В огне бода нет и не будет!
    До встречи в СССР 2.0!

    Всего записей: 1118 | Зарегистр. 14-12-2001 | Отправлено: 02:16 26-02-2005 | Исправлено: CheRt, 23:30 24-03-2005
    OLEX



    Silver Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Народ, подскажите, как из одного массива выбрать в другой определенное количество случайных значений и чтоб они не повторялись, а то у меня получилась не очень красивая и тормознутая конструкция:

    Код:
     
     
    # @s - исходный массив, @f - массив выбраных значений
     
    my (@f);
    $s=@s; # запоминаем размер массива
    $end = 10; # нужное количество значений
    $end = ($s < $end)?$s:$end; # проверяем если в исходном массиве меньше элементов чем надо, то устанавливаем $end в количество исходных элементов
     
    srand(time());
     
    for (1..$end) {
    REPEAT:
    $rnd = int (rand $s);
      foreach (@f) {
        if ($s[$rnd] == $_) {goto REPEAT}
      }
    push @f,$s[$rnd];
    }
     


    ----------
    Отче Наш, иже еси в моем PC. Да святится имя и расширение Твоё. ENTER.

    Всего записей: 3578 | Зарегистр. 09-07-2002 | Отправлено: 05:06 04-03-2005
    batva



    crazy administrator
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    use List::Util 'shuffle';
    my @f = (shuffle @s)[1..$end];

    Всего записей: 12593 | Зарегистр. 07-01-2001 | Отправлено: 06:25 04-03-2005
    softsafer2



    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    ## Если до этого мести переменная $var не задана, то ей присвоится 'default'
    $var = $var || 'default';

    Всего записей: 1 | Зарегистр. 18-03-2005 | Отправлено: 08:50 18-03-2005
    v7r



    Junior Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Извините, тема еще жива? Нашел здесь много интересного и решил внести свой посильный вклад в общее дело:
    сортировка числового массива из файла
    ./msr.pl --gen 1000 - создаёт in.txt с 1000 рандомных значений
    ./msr.pl сортирует in.txt в out.txt

    Код:
    #!/usr/bin/perl
     
    #~ Generation!
    if ($ARGV[0]=~/--gen/i) {
    open(OUT,">in.txt");
    if (($ARGV[1]<10) or ($ARGV[1]>1_000_000)) {$ln=50_000} else {$ln=$ARGV[1]};
    for (0..$ln) {
    $z=int(rand(65535));
    print OUT "$z\n";}
    close (OUT);
    } else {
     
    #~ Else.. No generation - sort!
    open (IN,"$ARGV[0]") or open (IN,"in.txt");
    open (OUT,">$ARGV[1]") or open (OUT,">out.txt");
    while (<IN>) {
    chomp;
    $arr[$i]=$_;
    $i++;
    }
     
    @arr=sort { $a <=> $b } (@arr);
    foreach (@arr) {
    print OUT "$_\n";
    }
    }

     
    ЗЫ: прошу не кидать камнями в за очень простой код

    Всего записей: 148 | Зарегистр. 24-11-2004 | Отправлено: 16:10 22-03-2005
    3style

    Newbie
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Я тут новенький, да и вообще PHP начал заниматься не давно (хотя и это преувеличение)...прошу мне подсказать, каким образом при нажатии на кнопку инфа перемещаеться из одной <textarea> в другую....за ранее огромное спасибо....nick_galoch@mail.ru




    :moderator: за дубль вопроса, тем более написанный в совершенно другой по тематике теме. /Cheery/

    Всего записей: 2 | Зарегистр. 22-03-2005 | Отправлено: 14:53 24-03-2005 | Исправлено: Cheery, 08:25 25-03-2005
    CheRt



    Advanced Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Аплоад картинок, также легко становится аплоадом других файлв в бинарном режиме...

    Код:
     
    #!/usr/bin/perl
    use CGI qw/param/;
    $upload_dir='../../fimg';
     
    if (param('action') eq 'upload') {
     ($check,$filename,$size)=upload();
     &showform;
    } else {
     &showform;
    }
     
    sub showform {
    print "Content-type:text/html;Charset:windows-1251\n\n";
    print <<HTML;
    <form method="post" action="$ENV{'SCRIPT_NAME'}" enctype="multipart/form-data">
     <input type="hidden" name="action" value="upload">
     <input type="file" name="filename"> <input type="submit">
    </form>
    HTML
     
     if (defined $check) {
      print "Успешность операции: $check<br>\nИмя файла: $filename<br>\nРазмер(ошибка, если операция не успешна): $size\n";
     }
    }
     
    sub upload {
     local $buffer;
     local $check=1;
     local $errmes='';
     local $file=param('filename');
     local $filename=$file;
     local $size=0;
     
     $filename=~s/^.*\\//igs;
     $filename=~s/\|//gs;
     if (!$filename) {$errmes="Невозможное имя файла!"; $check=0;}
     if ($filename!~/(\.jpg)|(\.gif)|(\.png)|(\.bmp)|(\.tif)|(\.tiff)/i) {$errmes='Неизвестный формат!'; $check=0;}
     if (-e "$upload_dir/$filename") {$errmes="Файл '$filename' уже существует!"; $check=0;}
     if ($check==1) {
      binmode($file);
      open(IF, ">$upload_dir/$filename") or die $!;  
       binmode IF;  
       while (read($file,$buffer,1024)) {print IF $buffer; $size++;}  
      close(IF);
      chmod 0744, "$upload_dir/$filename";
      $size.='кб';
     }
     if ($check==1) {return ($check,$filename,$size);} else {return ($check,$filename,$errmes);}
    }
     


    ----------
    В огне бода нет и не будет!
    До встречи в СССР 2.0!

    Всего записей: 1118 | Зарегистр. 14-12-2001 | Отправлено: 23:54 24-03-2005
    Kokoc

    Advanced Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Шаблонизатор Excel.
    Суть: имеются два файла:
    1) пустой (незаполненный) файл Excel (xls) - шаблон (форма) для последующего заполнения.
    2) текстовый файл данных в виде:
    <ячейка>=<значение>
    (например):
    A1=Отчет по товарам
    A2=товар1
    B2=123.56
    A3=товар2
    B3=10.00
    и т.д.
    При запуске скрипта формируется новый XLS-файл с заполненными ячейками.
    Запуск: perl txt2xls имя_шаблона_xls имя_файла_данных имя результир.файла_xls

    Код:
     
    use strict;
    use Cwd;
    use Win32::OLE;
     
    my $out_dir = cwd().'/';
    $out_dir =~ s/\//\\/g;
    my ($xls_file, $mim_file, $out_file, $line, $cell_no, $value);
    my ($workbook, $woksheet, $ex);
    my $help = "ЗАПУСК: txt2xls <файл-шаблон XLS> <файл данных> <результ.XLS>\n\n".
            "Файл отчета должен иметь структуру:\n".
            "  A1=значение\n".
            "где A1-ячейка, 'значение' - значение этой ячейки.\n";
    my %cells = ();
    ($xls_file, $mim_file, $out_file) = @ARGV;
    if (!(-f $xls_file) || !(-f $mim_file)) {
      print "ОШИБКА: Файл(ы) не найдены\n";  print $help;  exit 0;
    }
    open(IN,$mim_file) || die $!;
    while(<IN>) {
      if($_ !~ /^[\#|\;]/) {
        chomp;
        ($cell_no, $value) = split(/=/,$_);
        $cell_no =~ s/\s//g;
        $value =~ s/^\s//g;
        $cells{$cell_no} = $value;
      }
    }
    close IN;
    # Открываем Excel (выдрано из доки к Win32::OLE)
    eval {$ex = Win32::OLE->GetActiveObject('Excel.Application')};
    die "Excel not installed" if $@;
    unless (defined $ex) {
     $ex = Win32::OLE->new('Excel.Application', sub {$_[0]->Quit;})
           or die "Oops, cannot start Excel";
    }
    $workbook = $ex->Workbooks->Open($out_dir.$xls_file);
    my $worksheet   = $workbook->Worksheets(1);
    foreach $cell_no (sort keys %cells) {
      $worksheet->Range($cell_no)->{Value} = $cells{$cell_no};
    }
    $workbook->SaveAs($out_dir.$out_file);
    undef $workbook;
    $ex->Quit;
    undef $ex;
     


    Всего записей: 793 | Зарегистр. 06-06-2002 | Отправлено: 19:43 29-03-2005
    Vodomer



    Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    вот мой маленький код по пингу списка хостов из обыкновенного txt
    я новичек, т.ч. не судите строго и скажу сразу что пользовался O'Reilly - Perl Cookbook

    Цитата:
    #!/usr/bin/perl
    $file="servers.txt";
    open (FILE, $file) || die "oops servers.txt" ;
    @hosts=<FILE>;
    close (FILE);
    open (DEST, ">>logs.txt") || die "oops logs.txt" ;
    foreach $host (@hosts) {
    @result=`ping $host`;
    print DEST @result;
    }
    close (DEST);

     
    а вот так можно просто проверять есть ли хост онлайн

    Цитата:
    #!/usr/bin/perl
    use Net::Ping::External qw(ping);
     
    my @hosts = qw(192.168.0.1, 192.168.0.2, 192.168.3);
      my $num_alive = 0;
      foreach (@hosts) {
        $alive = ping(hostname => $_, count => 5, size => 1024, timeout => 3);
        print "$_ is alive!\n" if $alive;
        print "$alive\n" if $alive;
        $num_alive++;
      }
      print "$num_alive hosts are alive.\n";
     


    Всего записей: 319 | Зарегистр. 01-05-2003 | Отправлено: 09:31 19-04-2005
    batva



    crazy administrator
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Vodomer

    Цитата:
    а вот так можно просто проверять есть ли хост онлайн  

     
    маленькая поправка.
    Если хост не отвечает на пинг, это еще не значит, что он оффлайн.
     
    В качестве примера try ping ru-board.com

    Всего записей: 12593 | Зарегистр. 07-01-2001 | Отправлено: 17:42 19-04-2005
    Apart

    Full Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Как правильно решается вопрос с проверками на использование спецсимволов и пр. - в общем, чтобы не взломали? Приведите куски кода.
    В каких случаях нужно делать проверку, а в каких нет?




    Повторю для тех, кто плохо умеет читать или соображать - здесь просто приводят оригинальные решения, а НЕ задают вопросы /Cheery/

    Всего записей: 409 | Зарегистр. 10-05-2005 | Отправлено: 11:24 11-05-2005 | Исправлено: Cheery, 20:56 11-05-2005
    links

    Junior Member
    Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Вот мой небольшой вклад ввиде библиотеки, с помощью которой програмить сайты будет значительно легкче и удобнее, покрайней мере я сейчас уже все делаю с помощью нее.
     
    В данный момент библиотека содержит 19 часто используемых мною функций, некоторые из них:
    - обработчик хтмл шаблонов с возможностью вызова из шаблоны функцпий ядра и вставки перл скриптов в стиле пхп (одна из CMS его уже использует)
    - чтение обычных и multipart форм
    - чтение куков
    - обработка и вывод ошибок
    - ведение Log'а
    - вывод времени по шаблону
    - работа с SQL
    - обработка текста
    - время генерации страниц и т.п.
    - вывод на экран
     и др.
    Все функции взаимосвязаны между собой и имеют свои настройки.
     
    Все разрабатывал и писал один я, но от чужой помощи неоткажусь, поэтому пишите свои предложения и замечания, буду рад.
     
    Прошу любить и жаловать: http://newhit.fatal.ru/MyAPI.zip
     
    p.s. Т.к. я библиотеку писал для личных целей, то справки пока нету, а сейчас лень писать, но если каму интересно то напишу и примеров с использованием подкину.
     
    Добавлено:
    Самая простая гостевуха с использованием библиотеки(незабудьте скачать саму библиотеку):
      http://newhit.fatal.ru/guest.zip - использует SQL
      http://newhit.fatal.ru/guest2.zip - неиспользует SQL
      http://newhit.fatal.ru/guest3.zip - это самый интересный пример, очень наглядно показывает возможности обработчика шаблонов

    Всего записей: 148 | Зарегистр. 11-06-2004 | Отправлено: 21:16 13-05-2005 | Исправлено: links, 16:54 26-05-2005
    CheRt



    Advanced Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Пришлось тут возиться с прикладной математикой, а получать по десятку знаков после запятой неприятно, так что ф-ция округления до степени десятки:

    Код:
     
    sub round {
     my ($value,$power)=@_;
     
     my $tmp;
     $value=int($value*(10**-($power-1)));
     $tmp=$value;
     @_=split(//, $tmp);
     
     $tmp=@_;
     if ($_[$tmp-1]>=5) {
      $value=int($value/10)+1;
     } else {
      $value=int($value/10);
     }
     $value=$value/(10**-$power);
     return $value;
     (@_,$_,$value,$power)=();
    }
     

    Не очень грамотная, но в бошку не лезет как ее точнее сделать!
    Пример: round(2.84039011, -4) вернет число 2.8404.
    Соответственно положительно число округлит до сотен, тысяч и т.д.
     
    _____________________________________________
                                                                             
     \/ Есть, но ради такой фигни библиотеку искать?! \/

    ----------
    В огне бода нет и не будет!
    До встречи в СССР 2.0!





    А еще есть Number::Format

    Всего записей: 1118 | Зарегистр. 14-12-2001 | Отправлено: 09:06 18-05-2005 | Исправлено: CheRt, 08:22 19-05-2005
    CheRt



    Advanced Member
    Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Простейший пример создания мусора из двух слов(как правило логина и пароля). На практике в нагрузочных системах такой идиотизм лучше не применять - ресурсов жрет многовато, да и не слишком грамотный. Но для примера и для простеньких скриптов вполне. Для особых извращенцев(из тех кто учится) могу посоветовать переделать с вноски в мусор айпи на скажем некое сгенерированное при входе число, которое будет кидаться в кукису.
     
    Применять примерно так, зашли 1 раз в скрипт(или какой-то отдельный модель входа), залогинились, получили строку и давай ко всему лепить, а потом делаем compare используя соотв. логин, пасс.
     

    Код:
     
    sub mkhash {
     my ($firstword,$secondword)=@_;
     
     my $remip=$ENV{'REMOTE_ADDR'};
     my @remip=split(//, $remip);
     
     my @left=split(//, $firstword);
     my @right=split(//, $secondword);
     
     my $str='';
     
     my $exp=2.718281828;
     
     for (my $i=0;$i<@left;$i++) {
      $str.=int($exp**(ord($left[$i])+ord($right[$i])+ord($remip[$i])));
     }
     
     $str=~s/[^0-9]//gs;
     
     return $str;
     ($str,$firstword,$secondword,@left,@right,$i,$exp,$remip,@remip)=();
    }
     

     

    Код:
     
    sub comparehash {
     my ($hash,$firstword,$secondword)=@_;
     $firstword=~tr/[A-Z]/[a-z]/;
     if ($hash eq mkhash($firstword,$secondword)) {
      return 1;
     } else {
      return 0;
     }
     ($hash,$firstword,$secondword)=();
    }
     

     
    Короче вещь почти бесполезная, но когда-то меня прибило накатать

    ----------
    В огне бода нет и не будет!
    До встречи в СССР 2.0!

    Всего записей: 1118 | Зарегистр. 14-12-2001 | Отправлено: 08:20 19-05-2005
    Открыть новую тему     Написать ответ в эту тему

    Страницы: 1 2 3 4 5 6 7 8

    Компьютерный форум Ru.Board » Интернет » Web-программирование » Perl: Полезные решения

    Имя:
    Пароль:
    Сообщение

    Для вставки имени, кликните на нем.

    Опции сообщенияДобавить свою подпись
    Подписаться на получение ответов по e-mail
    Добавить тему в личные закладки
    Разрешить смайлики?
    Запретить коды


    Реклама на форуме Ru.Board.

    Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
    Modified by Ru.Board
    © Ru.Board 2000-2017

    BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

    Рейтинг.ru