Search     or:     and:
 LINUX 
 Language 
 Kernel 
 Package 
 Book 
 Test 
 OS 
 Forum 
iakovlev.org

FAQ

Числа

Для округления можно использовать традиционный си-шный синтаксис :
 	printf("%.3f", 3.1415926535);       # prints 3.142
Можно использовать стандартный модуль POSIX :
 	use POSIX;
     $ceil   = ceil(3.5);                        # 4
     $floor  = floor(3.5);                       # 3	
Для совершения операции над массивом чисел можно использовать map :
 	 @single=(1,2,3,4,5);    
 	 @triple = map { 3 * $_ } @single; 
Следующая функция конвертирует строку и возвращает число :
     sub getnum {
         use POSIX qw(strtod);
         my $str = shift;
         $str =~ s/^\s+//;
         $str =~ s/\s+$//;
         $! = 0;
         my($num, $unparsed) = strtod($str);
         if (($str eq '') || ($unparsed != 0) || $!) {
             return undef;
         } else {
             return $num;
         } 
     } 
Как разбить большое число запятыми на группы по 3 цифры :
     sub commify {
         local $_  = shift;
         1 while s/^(-?\d+)(\d{3})/$1,$2/;
         return $_;
     }
     $n = 23659019423.2331;
     print "GOT: ", commify($n), "\n";

Даты

Порядковый номер дня для текущей даты :
 	$day_of_year = (localtime(time()))[7];  
Порядковый номер недели для текущей даты :
 	$week_of_year = int($day_of_year / 7);    
Для получения разницы 2-х дат их можно хранить в секундном эквиваленте и затем вычесть

Строки

Для удаления escape-символов на концах строк - "\n" или "\t" - можно использовать
 	s/\\(.)/$1/g;
Превращение "abbcccd" в "abccd":
     s/(.)\1/$1/g;
Для реверса строки используйте функцию reverse
 	$reversed = reverse $string;
Замена подстроки :
 	$a="1234567890";
 	$first_byte = substr($a, 5, 5);  # результат : $first_byte=67890
Или так :
 	substr($a, 0, 3) = "Tom";
Последний пример можно сделать и так :
 	$a="1234567890";
 	$a =~ s/^.../Tom/;
Подсчет количества вхождений символа в строку :
 	$string = "ThisXlineXhasXsomeXx'sXinXit";
 	$count = ($string =~ tr/X//);
Подсчет числа отрицательных чисел в строке :
     $string = "-9 55 48 -2 23 -76 4 14 -44";
     while ($string =~ /-\d+/g) { $count++ }
     print "There are $count negative numbers in the string";

Массивы

В следующей задаче имеется неуникальный числовой массив - оставить только уникальные значения
 	@in = (1,1,1,1,1,1,2,1,1,1,1,3,4,5,6,5,4,3,2,1,2,3,4,5);
 	@out = grep(!$saw{$_}++, @in);
 Результат - @in=(1,2,3,4,5,6);
 
 Как найти элемент массива , отвечающий условию :
 	@array=(1,2,33,4,5,3);
 	for ($i=0; $i < @array; $i++) {
 		if ($array[$i] == 3) {
 		$found_index = $i;
 		last;
 		}
 	}    
 
 Как расставить элементы массивы случайным образом :
     sub fisher_yates_shuffle {
         my $array = shift;
         my $i;
         for ($i = @$array; --$i; ) {
             my $j = int rand ($i+1);
             next if $i == $j;
             @$array[$i,$j] = @$array[$j,$i];
         }
     }
 @array=(1,2,3,4,5,6,7,8,9);
 &fisher_yates_shuffle( \@array ); 
 
 Как сгенерировать случайный массив :
     srand;
     @new = ();
     @old = 1 .. 20;  # just a demo
     while (@old) {
         push(@new, splice(@old, rand @old, 1));
     }
     
 Обработка элементов массива :
 	for (@new) {
 		s/19/199/;     # заменить 19 на 199
 	}
 	
 Выбрать случайный элемент массива :
     @new = 1 .. 20;  
     $index   = rand @new;
     $element = $new[$index];

Хэши

Для перебора элементов хэша можно использовать цикл :
 	%hash = (
 		'шляпа' => 'серая',
 		'водка' => 'горькая',
 		'вобла' => 'вкусная',
 		'штаны' => 'широкие',
 		'пиво' => 'темное',
 		'игрушка' => 'любимая');
 			
 	while ( ($key, $value) = each %hash) {
 		print "$key = $value\n";
 	}    
 
 	Узнать число элементов хэша :
 	    $num_keys = scalar keys %hash;
 	    
  Разница между операциями 'undef' и 'delete' : операция 
  	        delete $hash{'шляпа'} 
 удаляет пару  ключ - значение  .
 Операция 
  	undef $hash{'шляпа'} 
 ничего не удаляет , а делает 'шляпа' => 'undef'.

Файлы

Для каких-то локальных изменений в произвольном месте файла предлагается делать временную копию файла в памяти и после изменений записывать ее поверх самого файла :
 $old = $file;
 $new = "$file.tmp.$$";
 $bak = "$file.bak";
 
 open(OLD, "< $old")         or die "can't open $old: $!";
 open(NEW, "> $new")         or die "can't open $new: $!";
 
 # Correct typos, preserving case
 while () {
         s/\b(p)earl\b/${1}erl/i;
         (print NEW $_)          or die "can't write to $new: $!";
 }
 
 close(OLD)                  or die "can't close $old: $!";
 close(NEW)                  or die "can't close $new: $!";
 
 rename($old, $bak)          or die "can't rename $old to $bak: $!";
 rename($new, $old)          or die "can't rename $new to $old: $!";
 		
 Удалить последнюю строку в файле :
         open (FH, "+< $file");
         while (  ) { $addr = tell(FH) unless eof(FH) }
         truncate(FH, $addr);
         
 Подсчитать число строк в текстовом файле :
         $lines = 0;
         open(FILE, $filename) or die "Can't open `$filename': $!";
         while (sysread FILE, $buffer, 4096) {
                 $lines += ($buffer =~ tr/\n//);
         }
         close FILE;
 
 Открыть массив файлов и распечатать их 
 @names = qw(motd termcap passwd hosts);
 my $i = 0;
 foreach $filename (@names) {
         local *FH;
         open(FH, "/etc/$filename") || die "$filename: $!";
         $file{$filename} = [ $i++, *FH ];
 }
 
 # Using the filehandles in the array
 foreach $name (sort { $file{$a}[0] <=> $file{$b}[0] } keys %file) {
         my $fh = $file{$name}[1];
         my $line = <$fh>;
         print "$name $. $line";
 }
 
 Файловые операции :
 use Fcntl;
 Открыть файл на чтение :
 open(FH, "< $path")                                 || die $!;
 sysopen(FH, $path, O_RDONLY)                        || die $!;    
 Открыть файл на запись или создание :
 open(FH, "> $path") || die $!;
 sysopen(FH, $path, O_WRONLY|O_TRUNC|O_CREAT)        || die $!;
 sysopen(FH, $path, O_WRONLY|O_TRUNC|O_CREAT, 0666)  || die $!; 
 Открыть файл для добавления или создания :
 open(FH, ">> $path") || die $!;
 sysopen(FH, $path, O_WRONLY|O_APPEND|O_CREAT)       || die $!;
 sysopen(FH, $path, O_WRONLY|O_APPEND|O_CREAT, 0666) || die $!;
 Открыть существующий файл для добавления
 sysopen(FH, $path, O_WRONLY|O_APPEND)
 Открыть существующий файл для изменений :
 open(FH, "+< $path")                                || die $!;
 sysopen(FH, $path, O_RDWR)                          || die $!; 
 Увеличение счетчика посещений на сайте :
 use Fcntl;
 sysopen(FH, "numfile", O_RDWR|O_CREAT)       or die "can't open numfile: $!";
 flock(FH, 2)                                 or die "can't flock numfile: $!";
 $num =  || 0;
 seek(FH, 0, 0)                               or die "can't rewind numfile: $!";
 truncate(FH, 0)                              or die "can't truncate numfile: $!";
 (print FH $num+1, "\n")                      or die "can't write numfile: $!";
 # DO NOT UNLOCK THIS UNTIL YOU CLOSE
 close FH                                     or die "can't close numfile: $!";
 Как изменить бинарный файл - всего одну произвольную запись в нем :
 $RECSIZE = 220; # size of record, in bytes
 $recno   = 37;  # which record to update
 open(FH, " + < somewhere " ) || die "can't update somewhere: $!";
 seek(FH, $recno * $RECSIZE, 0);
 read(FH, $record, $RECSIZE) == $RECSIZE || die "can't read record $recno: $!";
 # munge the record
 seek(FH, $recno * $RECSIZE, 0);
 print FH $record;
 close FH; 
 Одновременная работа сразу с несколькими файлами :
         open (FH, "| tee file1 file2 file3");
         for $fh (FH1, FH2, FH3) { print $fh "whatever\n" } 
Как задекларировать структуру ? Специально этого делать не нужно , можно просто использовать хэш :
     $person = {};                   # new anonymous hash
     $person->{AGE}  = 24;           # set field AGE to 24
     $person->{NAME} = "Nat";        # set field NAME to "Nat"    
Модуль - это пакет , расположенный в файле с одноименным названием . Например , модуль Hello::There будет находиться в подкаталоге Hello/There.pm . Пример модуля :
 package Some::Module;  # assumes Some/Module.pm
 use strict;
 BEGIN {
 use Exporter   ();
 use vars       qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 
 ## set the version for version checking; uncomment to use
 ## $VERSION     = 1.00;
 
 # if using RCS/CVS, this next line may be preferred,
 # but beware two-digit versions.
 $VERSION = do{my@r=q$Revision: 1.21 $=~/\d+/g;sprintf '%d.'.'%02d'x$#r,@r};
 
 @ISA         = qw(Exporter);
 @EXPORT      = qw(&func1 &func2 &func3);
 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
 
 # your exported package globals go here,
 # as well as any optionally exported functions
 @EXPORT_OK   = qw($Var1 %Hashit);
 }
 use vars      @EXPORT_OK;
 
 # non-exported package globals go here
 use vars      qw( @more $stuff );
 
 # initialize package globals, first exported ones
 $Var1   = '';
 %Hashit = ();
 
 # then the others (which are still accessible as $Some::Module::stuff)
 $stuff  = '';
 @more   = ();
 
 # all file-scoped lexicals must be created before
 # the functions below that use them.
 
 # file-private lexicals go here
 my $priv_var    = '';
 my %secret_hash = ();
 
 # here's a file-private function as a closure,
 # callable as &$priv_func;  it cannot be prototyped.
 my $priv_func = sub {
         # stuff goes here.
 };
 
 # make all your functions, whether exported or not;
 # remember to put something interesting in the {} stubs
 sub func1      {}    # no prototype
 sub func2()    {}    # proto'd void
 sub func3($$)  {}    # proto'd to 2 scalars
 
 # this one isn't exported, but could be called!
 sub func4(\%)  {}    # proto'd to 1 hash ref
 
 END { }       # module clean-up code here (global destructor)
 
 1;            # modules must return true
 
     
     
    
Оставьте свой комментарий !

Ваше имя:
Комментарий:
Оба поля являются обязательными

 Автор  Комментарий к данной статье