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

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

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

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

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

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/
    • Всего записей: 582 | Зарегистр. 04-09-2002 | Отправлено: 07:12 14-07-2004 | Исправлено: Cheery, 23:38 01-03-2008
    sadasaf



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



    Проблемы со зрением? Перечитайте еще раз шапку /Cheery/
    Всего записей: 216 | Зарегистр. 18-08-2008 | Отправлено: 18:40 03-12-2008 | Исправлено: Cheery, 18:59 03-12-2008
    rtyug



    Full Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    SQL::Abstract
     
    очень понравился вместо ORM еще DBIx::Abstract
    даже есть SQL оператор limit

    Код:
     
    #!/usr/bin/perl
    #
    use strict;
    use warnings;
    use SQL::Abstract;
    use CGI::Carp qw(fatalsToBrowser);
    use DBI;
    # ---- print header ----
    print "Content-Type: text/html; charset=utf-8\n\n";
    # ---- connect to sqlie db file ----
    my $dbh = DBI->connect("dbi:SQLite:dbname=my.db","","");
    my $sql = SQL::Abstract->new;
    # ---- prepare input data ----
    my %data = (
            name => 'John',
            lastname => 'Miller',
        );
    my ($stmt,@bind) = $sql->insert('mytable', \%data);
    # ---- insert data into my.db ----
    my $sth = $dbh->prepare($stmt);
       $sth->execute(@bind);  

     
    Альтернативный вариант наследовать конструктор
    (ссылка на код)

    Код:
     
    use base qw[Catalyst::Base];
    *new = Catalyst::Base->can('new');

     
    Использование встроенных php функций в perl
    http://search.cpan.org/~kudarasp/PHP-Strings-0.28/Strings.pm  

    Код:
     
    # FUNCTIONS
     
        * addcslashes
        * addslashes
        * bin2hex
        * chop
        * chr
        * chunk_split
        * convert_cyr_string
        * count_chars
        * crc32
        * crypt
        * echo
        * explode
        * fprintf
        * get_html_translation_table
        * hebrev
        * hebrevc
        * html_entity_decode
        * htmlentities
        * htmlspecialchars
        * implode
        * join
        * levenshtein
        * ltrim
        * md5
        * md5_file
        * metaphone
        * money_format
        * nl2br
        * nl_langinfo
        * number_format
        * ord
        * parse_str
        * print
        * printf
        * quoted_printable_decode
        * quotemeta
        * rtrim
        * setlocale
        * sha1
        * sha1_file
        * similar_text
        * soundex
        * sprintf
        * sscanf
        * str_ireplace
        * str_pad
        * str_repeat
        * str_replace
        * str_rot13
        * str_shuffle
        * str_split
        * str_word_count
        * strcasecmp
        * strchr
        * strcmp
        * strcoll
        * strcspn
        * strip_tags
        * stripcslashes
        * stripos
        * stripslashes
        * stristr
        * strlen
        * strnatcasecmp
        * strnatcmp
        * strncasecmp
        * strncmp
        * strpos
        * strrchr
        * strrev
        * strripos
        * strrpos
        * strstr
        * strtolower
        * strtoupper
        * strtr
        * substr
        * substr_compare
        * substr_count
        * substr_replace
        * trim
        * ucfirst
        * ucwords
        * vprintf
        * vsprintf
        * wordwrap  
     
        use PHP::Strings;
     
        my $slashed = addcslashes( $not_escaped, $charlist );
        my $wordcount = str_word_count( $string );
        my @words     = str_word_count( $string, 1 );
        my %positions = str_word_count( $string, 2 );
        my $clean = strip_tags( $html, '<a><b><i><u>' );
        my $unslashed = stripcslashes( '\a\b\f\n\r\xae' );
     

     
    конфиг apache MVC Catalyst mod_perl  

    Код:
    PerlSwitches -I/home/x0/data/www/MyApp/lib
     
    PerlModule MyApp    
    <VirtualHost *:80>
     
    DocumentRoot /home/x0/data/www/MyApp/root
     
     ErrorLog /home/x0/data/www/MyApp/error.log
       CustomLog /home/x0/data/www/MyApp/mod_access.log combined
      ServerName x0.org.ua
     
          <Directory /home/x0/data/www/MyApp>
     AllowOverride None                                                              
     Order allow,deny                                                                
     Allow from all  
     
            </Directory>
     
      <Location />
                SetHandler          modperl
                PerlResponseHandler MyApp
      </Location>
           
            # you can also run your app in any non-root location
     
    </VirtualHost>

     
     
    пример реализации движка большой программы, как Диспатч
     
    ПРИМЕРНО:

    Код:
     
    #!/usr/bin/perl
    use DBI;
    print join("\n",&get_sub_list('DBI'));
    sub get_sub_list{
      my $m=shift;
      no warnings;
      my ($code,@fn,@a);
      print $m;
      eval('@a=keys(%'.$m.':;');
      foreach (@a){
        next unless /^[\w_]/;
        push(@fn,$_) if eval('defined(*'.$m.'::'.$_.'{CODE})');
      }
      use warnings;
      @fn
    }
     
     
    use MyPr::Form::Bla-bla;
    use MyPr::Valid::Bla-bla;
    use MyPr::Session::Bla-bla;
    use MyPr::Bla-bla::Bla-bla;
    всего 30-40
    ...............................
     
     
    if (defined $param->{form} ) {
     
        my @m = join("",&get_sub_list('MyPr::Form::'.$param->(form)));
         
       if (defined @m) {
         my @vm = join("",&get_sub_list('MyPr::Valid::'.$param->(form)));
       
          foreash (@vm) {
           my $obj = 'MyPr::Valid::'.$param->(form)->new($param);
           $obj->$_();
         }
     
       }
     
        foreash (@m) {
     
            my $obj = 'MyPr::Form::'.$param->(form)->new();
     
            $obj->$_();
     
    } else {
     
     
        if ($param->{global-bla}) {
     
        my @mb = join("",&get_sub_list('MyPr::Bla-bla::'.$param->(form)));
     
        foreash (@mb) {
     
            my $obj = 'MyPr::Bla-bla::'.$param->(form)->new();
     
            $obj->$_();
     
        }
     
     
    }

    http://unixforum.org.ua/index.php?topic=23928
    Всего записей: 490 | Зарегистр. 13-05-2009 | Отправлено: 11:54 03-06-2009 | Исправлено: rtyug, 11:57 03-06-2009
    Oleg Tarusov



    Junior Member    		Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Юникод в UTF-8

    Код:
    sub unicode_to_utf8 {
        return  hex unpack('H12', pack ('U', shift));
    }

     
    UTF-8 в Юникод

    Код:
    sub utf8_to_unicode {
        my @array = unpack ('C*', pack ('H*', sprintf '%x', shift));
        if (@array == 1) {
            return $array[0];
        } elsif (@array == 2) {
            return (($array[0] & 0x1F) << 6) | ($array[1] & 0x3F);
        } elsif (@array == 3) {
            return (($array[0] & 0xF) << 12) | (($array[1] & 0x3F) << 6) | ($array[2] & 0x3F);
        } elsif (@array == 4) {
            return (($array[0] & 7) << 18) | (($array[1] & 0x3F) << 12) | (($array[2] & 0x3F) << 6)  | ($array[3] & 0x3F);
        } elsif (@array == 5) {
            return (($array[0] & 3) << 24) | (($array[1] & 0x3F) << 18) | (($array[2] & 0x3F) << 12) | (($array[3] & 0x3F) << 6)  | ($array[4] & 0x3F);
        } elsif (@array == 6) {
            return (($array[0] & 1) << 30) | (($array[1] & 0x3F) << 24) | (($array[2] & 0x3F) << 18) | (($array[3] & 0x3F) << 12) | (($array[4] & 0x3F) << 6) | ($array[5] & 0x3F);
        } else {
            return undef;
        }
    }

     
    Если вы попытаетесь использовать модуль MIME::Base64 для кодирования в base64 строки в utf8, то получите такую ошибку "Wide character in subroutine entry" (если в строке будут только символы с кодами меньше 127 её не будет).
     
    Есть два решения этой проблемы:
     
    1) Сбросить флаг utf-8

    Код:
    use MIME::Base64;
    use Encode qw(_utf8_off);
    use utf8;
    $str = 'Текст в utf-8';
    _utf8_off($str);
    $str = encode_base64($str, '');
    print $str;
     

     
    2) либо использовать эту функцию:

    Код:
    sub my_encode64 {
        my $str = shift;
        my $new_str = '';
        for (my $i = 0; $i <= length $str; $i++) {
            my $char = substr($str, $i, 1);
            if (ord($char) <= 255) {
                $new_str .= $char;
            } else {
                $new_str .= pack ('H*', sprintf '%x', unicode_to_utf8(ord($char)));
            }
        }
        $new_str = MIME::Base64::encode_base64($new_str, '');
        return $new_str;
    }
     

     
    где unicode_to_utf8 - функция, написанная выше
    Всего записей: 175 | Зарегистр. 25-02-2006 | Отправлено: 13:40 08-06-2009 | Исправлено: Oleg Tarusov, 13:43 08-06-2009
    Oleg Tarusov



    Junior Member    		Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Долго бился как в Active Perl выводить строки с кирилицей в консоль. Консоль в Windows XP в кодировке cp866, вот одно из решений, если файл в кодировке utf-8
     

    Код:
    use Encode;
    use utf8;
    $str = 'Йо';
    Encode::_utf8_off($str);
    Encode::from_to($str, 'utf-8', 'cp866');
     

     
    Поиск файлов из консоли в Винде:
     

    Код:
    perl -MFile::Find -MCwd -e "$path = getcwd;finddepth(sub {print $File::Find::name.\"\n\"}, $path)" | perl -ne "print if /name/"

     
    Для Unix/Linux есть функция find, но если использовать пример выше, то его надо переписать так:
     

    Код:
    perl -MFile::Find -MCwd -e '$path = getcwd;finddepth(sub {print $File::Find::name."\n"}, $path)' | perl -ne 'print if /name/'

     
     
    perl как grep (работает и в Windows, команда more есть в ней)
     

    Код:
    more файл | perl -ne "print if /word/"

     
     

    Цитата:
    Попытка создать date() как в php

     

    Код:
    use POSIX qw(strftime);
    print strftime("%d.%m.%Y", localtime());

     
    Формат у strftime почти как у date в php
    Всего записей: 175 | Зарегистр. 25-02-2006 | Отправлено: 11:50 16-06-2009 | Исправлено: Oleg Tarusov, 12:02 16-06-2009
    Oleg Tarusov



    Junior Member    		Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Смена 1 на 0, 0 на 1:
     

    Код:
    $i = 1 - $i;

    или

    Код:
    $i ^= 1;

     
    Отсортировать массив, но сделать так, чтобы одно значение было всегда на первом месте:
     

    Код:
    #!/usr/bin/perl
    @a = (1, 3, 4, 5, 6, 2);
    @a = sort my_cmp @a;
     
    print "@a";#Выведет 5 1 2 3 4 6
    sub my_cmp {
        if ($a == 5) {
            return -1;
        } elsif ($b == 5) {
            return 1
        } else {
            return $a <=> $b;
        }
    }
     
    Всего записей: 175 | Зарегистр. 25-02-2006 | Отправлено: 19:54 13-08-2009 | Исправлено: Oleg Tarusov, 19:54 13-08-2009
    Oleg Tarusov



    Junior Member    		Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Преобразование IP-адреса в число.
     

    Код:
    $ip = '127.0.0.1';
    $int_ip =  unpack('N', pack('C4', split /\./, $ip));

     
     
    Преобразование IP-адреса в шестнадцатеричное число.
     

    Код:
    $ip = '127.0.0.1';
    $int_ip =  unpack('H*', pack('C4', split /\./, $ip));

    Всего записей: 175 | Зарегистр. 25-02-2006 | Отправлено: 12:51 24-09-2009
    vecialfor

    Junior Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Народ подскажите где ошибка. Через командную строку передаю имя папки. И хочу вывести ее содержимое, при этом если в директории есть каталоги то вывести их отдельно. Проблема в том, что  ключ "-d" определяет как каталог только файлы "." и ".." вот код:  
     
     
    #!/usr/bin/perl -w
    chomp ($directory = $ARGV[0]);
    print "DIRECTORY NAME IS $directory\n";
    opendir (DIRECTORY, "$directory");                                                                                                        
    @files=readdir(DIRECTORY);                                                                                                                 
    print "There are: @files\n";
     
     
    foreach (@files) {
            if (-d $_) {    
            print "This is a directory: $_\n";
            }            
            else {  
            print "This is a file $_\n";
            }    
            }
    closedir(DIRECTORY);
    Всего записей: 197 | Зарегистр. 04-07-2007 | Отправлено: 15:20 19-10-2009
    aar



    Gold Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    vecialfor
     

    Цитата:
    Народ подскажите где ошибка.

     
    Со зрением все в порядке? ШАПКУ ЧИТАЙ!
     

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


    ----------
    * * *
    Всего записей: 7080 | Зарегистр. 20-11-2003 | Отправлено: 15:26 19-10-2009
    Delta RuBoard



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

    Код:
    print join "\n", f('E:/PICTURES', "*.jpg");
     
    sub f {return ( grep {!-d} (glob("$_[0]/$_[1]"), (map {f($_,$_[1])} grep {-d} glob("$_[0]/*"))) )}

     
    вывод списка топ-10 самых популярных слов длинной 2+ символов во входном файле:

    Код:
     
    $h{lc $_}++ for ( ( join('',<>)=~/\b\w{2,}\b/g) );
    print join("\n", grep {$_} (map {"$_: $h{$_}"} sort {$h{$b} <=> $h{$a} } keys %h)[0..9]);
     

     
    автор не я, но все же вроде как интересные скрипты

    ----------
    мой маленький блог
    Создание on-line игр
    Всего записей: 382 | Зарегистр. 21-06-2005 | Отправлено: 22:48 14-12-2009
    rtyug



    Full Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    перебрать массив-хэшей и вывести в map с использованием next и last
     
    не мог выйти из цикла с помощью next и last, нашел вариант просто отдать
    Код:
    ()

    (т.е. найти лучший вариант не мог)
     
    пример решения:

    Код:
     
    my $aa;
     
    $aa->[0] = { tt=>2, yy => 0};
    $aa->[1] = { tt=>1, yy => 4};
    $aa->[2] = { tt=>1, yy => 5};
     
     
       my $where_in = join ",",  map { !$_->{'tt'} ? $_->{'yy} : () } @$aa;
     

     
    еще один очень оптимизированный способ сгенерировать пароль
     

    Код:
    print join'',map $$_[rand@$_],([0..9,'a'..'z'])x20;

     
    зеркало, мой вариант еще тут, продублировал:
    http://www.x0.org.ua/blog/user/1/view/27
    Всего записей: 490 | Зарегистр. 13-05-2009 | Отправлено: 16:19 08-05-2010 | Исправлено: rtyug, 16:29 08-05-2010
    links

    Junior Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    часто использую такой скрипт, чтоб читать строки в обратном порядке из файла
    писал я и очень давно :)

    Код:
     
    package OpenDB;
     
    =head1 INFO
     
      Библиотека функций для получения строк из файла в обратном порядке
      Большие файлы, например из 50тыс строк съедает как семечку
     
      Автор: Низовцев Алексей
     
      E-mail: alex-niz(СБК)mail.ru
     
     
      Использование:
     
       use OpenDB;
     
       my $db = new OpenDB('news.db') or die $!;
     
       my $all_line = $db->{'all_line'}; # количество строк в файле
     
       my @array = $db->ReadLine(11, 5); # Собирает массив из 5 строк начиная с 11-й из файла, тоесть возвращает 11, 12, 13, 14 и 15 строки, конечно если есть такие
     
       $db->Close();
     
    =cut
     
    #####################################
    use strict;
     
    sub new {
     
     my $class = bless { }, shift;
     
     $class->{'file'} = shift;
     
     open($class->{'db'}, "<$class->{'file'}") or return;
     flock($class->{'db'}, 1) or return;
     
     my $file = $class->{'db'};
     while (<$file>) {}
     $class->{'all_line'} = $.;
     
     return $class;
    }
     
    #=============================================================
     
    sub ReadLine {
     
     my $class = shift;
     
     my $start_line = shift;
     
     my $all_line = shift;
     
     if ($start_line < 1) {$start_line = 1}
     if ($start_line > $class->{'all_line'}) {return}
     if ($all_line eq 'all') {$all_line = $class->{'all_line'}}
     if ($all_line < 1) {$all_line = 1}
     
     seek ($class->{'db'}, 0, 0);
     
     my @array;
     
     my $start = $class->{'all_line'}-$start_line+1;
     my $end = $class->{'all_line'}-$start_line+1-$all_line;
     my $line = 0;
     my $file = $class->{'db'};
     while (<$file>) {
      $line++;
      if ($line > $start) {last}
      if ($line > $end) {chomp ($_); push (@array, $_)}
     }
     
     return reverse @array;
     
    }
     
    #=============================================================
     
    sub Close {
     
     my $class = shift;
     
     close($class->{'db'}) or return;
     
     $class = ();
     
    }
     
    #=============================================================
     
    sub AllLine {
     
     my $class = shift;
     
     return $class->{'all_line'};
    }
     
    1;
     
    Всего записей: 148 | Зарегистр. 11-06-2004 | Отправлено: 11:28 10-06-2011
    Anton_Y



    Full Member    		Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    links
    А вот не подскажешь ли какойнибудь модуль для работы с файлами ну очень большими.. к примеру 500тыс строк, миллион строк.. Чтобы легко можно было перебрать его, вывести произвольные строки..  
    Чтобы не грузить файл в оперативу, а как-нибудь пооптимальнее )
    Всего записей: 582 | Зарегистр. 04-09-2002 | Отправлено: 12:08 10-06-2011
    links

    Junior Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Anton_Y
    попробуйте,потестируйте, миллион строк он точно переварит, но если вы их все в память не решите загружать
    этот скрипт какраз весь файл в оперативу не грузит, грузит только выбранные строки
    Всего записей: 148 | Зарегистр. 11-06-2004 | Отправлено: 12:14 10-06-2011
    Jikor



    BANNED    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Спасибо за полезные советы.



    не нужно флудом набирать сообщения /Cheery/
    Всего записей: 11 | Зарегистр. 04-06-2012 | Отправлено: 16:01 04-06-2012 | Исправлено: Cheery, 16:05 04-06-2012
    mark74

    Full Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    может кому пригодится скрипт:
     

    Код:
    =pod
    MOdem COntrol over telnet script
    Использует telnet-протокол для управления модемом. Позволяет
    узнать внешний IP и перезагрузить модем. Вызов:
     
    perl moco.pl
    perl moco.pl reset
     
    Протестирован на D-Link DSL-500T ADSL Router. Firmware Version:
     V2.01B01T01.RU.20060620
     
    http://forum.ru-board.com/profile.cgi?action=show&member=mark74
    Tomsk, 2012
    =cut
    use strict;
    use warnings;
    use Net::Telnet ();
     
    my $ip;
    my $reset = 0;
    my $t = new Net::Telnet (Timeout => 10,
                             Prompt => '/# $/',
                             Errmode => "return");
     
    #-----------------------------------------------------------------------
    # переустанавливает соединение
    # возвращает внешний IP модема, или '' если нет интернета, или 'timeout'
    #-----------------------------------------------------------------------
    sub chk_ip () {
      my @lines;
      $t->close or die "chk_ip:1";
      $t->open('192.168.1.1') or return 'timeout';
      $t->login('admin', 'admin') or die "chk_ip:2";
      @lines = $t->cmd("ifconfig ppp0") or die "chk_ip:3";
      @lines = grep(/inet addr:/, @lines);
      my $r = '';
      if ($#lines >= 0) {
        $lines[0] =~ /:([^\s]+)/;
        $r = $1 or die "chk_ip:4";
      }
      return $r;
    }
     
    #------------------------------------------------------------------------
    $|++; # autoflush after every print
     
    $_ = shift @ARGV;
    if (defined $_) {
      $reset = 1 if $_ eq 'reset';
    }
     
    if ($reset) {
      print "Подключение...\n";
      $ip = chk_ip();
      die "Не удалось подключиться к модему" if $ip eq 'timeout';
      if ($ip) {
        print "Старый IP: $ip\n";
      } else {
        print "Нет внешнего IP\n";
      }
      print "\n";
     
      print "Перезагрузка...\n";
      $t->cmd("reboot");
    }
     
    print "Подключение";
    for (my $i = 0; $i < 30; $i++) {
      print ".";
      $ip = chk_ip();
      next if $ip eq 'timeout';
      last if $ip;
      sleep 5;
    }
    print "\n";
     
    if ($ip) {
      if ($reset) {
        print "Новый IP: $ip\n";
      } else {
        print "Внешний IP: $ip\n";
      }
    } else {
      print "Нет внешнего IP\n";
    }
    Всего записей: 482 | Зарегистр. 25-01-2009 | Отправлено: 18:57 22-06-2012 | Исправлено: mark74, 18:59 22-06-2012
    CheRt



    Advanced Member    		Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
    Простенький поиск по шаблону с консоли по архиву рассылки Moscow.pm (*.pm) (с кэшированием).
    http://codepaste.ru/11948/
     
    Есть поисковики, конечно, и они найдут многое гораздо лучше. Потому для нищевых задач, когда помнишь, что обсуждалось, но когда именно - нет.

    ----------
    В огне бода нет и не будет!
    До встречи в СССР 2.0!
    Всего записей: 1118 | Зарегистр. 14-12-2001 | Отправлено: 16:44 03-10-2012 | Исправлено: CheRt, 16:45 03-10-2012
    fishsonar

    Newbie    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Cпасибо! Попробую так! Обычно програмно менял.
    Всего записей: 1 | Зарегистр. 15-12-2012 | Отправлено: 18:47 15-12-2012
    OLEX



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

    Код:
    @array = [ grep $_!= 3 , @array ];

     
    это удалит элемент, значение которого равно 3, а все последующие элементы сместятся на одну позицию влево.
     
    Кстати говоря, если в массиве есть повторяющиеся значения, то они удалятся тоже.
     
    Взято из http://www.feofilaktov.ru/page/odnomernyj-massiv-perl
    Всего записей: 3591 | Зарегистр. 09-07-2002 | Отправлено: 19:11 06-04-2013
    mfn9



    Junior Member    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Добрый день!
     
    Помогите написать скрипт
    мне необходимо чтобы скрипт сравнил время изменения файла и текущее время
    и если есть разница в 2 или больше минуты то выполнить действие
     
    для текущего времи использую

    Код:
     
    my $nowtime = localtime(time);  
    print ("$nowtime\n");
     
    вывод:
    Tue Jun 25 12:42:10 2013
     

     
    но как узнать время изменения файла?
    в инете нашел такое, но мне не выдает знаение:

    Код:
     
    my $mtime = (stat $file)[9];  
    print $mtime,"\n";
     
    вывод:
    Use of uninitialized value in concatenation (.) or string at /loadfile.pl line 104.
     

     
    и еще не понятно как сравнить эти даты
     
    код самой функции в которой необходимо прописать это условие:

    Код:
     
    sub scan_dir
    {
    my ($dir) = @_;
    for my $file (glob($dir.'bb*'))
        {
            if ( -f $file )
            {
     
            }
    }
     

     
    система HPUX



    Перечитайте шапку - данная тема не для вопросов! /Cheery/
    Всего записей: 63 | Зарегистр. 05-12-2005 | Отправлено: 14:05 25-06-2013 | Исправлено: Cheery, 20:38 25-06-2013
    zhernosek

    Newbie    		Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
    Требуется программист со знаниями php, js, html, css, git.
     
    (удалено)



    Читать научитесь, сначала..
    Работа для веб/мастера/программиста (от РАБОТОДАТЕЛЕЙ)
    /Cheery/
    Всего записей: 1 | Зарегистр. 06-08-2013 | Отправлено: 19:43 06-08-2013 | Исправлено: Cheery, 21:11 06-08-2013
    Открыть новую тему     Написать ответ в эту тему

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

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


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

    Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
    Modified by Ru.B0ard
    © Ru.B0ard 2000-2024

    BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

    Рейтинг.ru