Подтвердить что ты не робот

Как перевести оболочку script в Perl?

У меня есть оболочка script, довольно большая. Теперь мой босс говорит, что я должен переписать его в Perl. Есть ли способ написать Perl script и использовать существующий код оболочки, как в моем Perl script. Что-то похожее на Inline::C.

Есть ли что-то вроде Inline:: Shell? Я посмотрел встроенный модуль, но он поддерживает только языки.

4b9b3361

Ответ 1

Я отвечу серьезно. Я не знаю какой-либо программы для перевода оболочки script в Perl, и я сомневаюсь, что любой модуль интерпретатора обеспечит преимущества производительности. Поэтому я расскажу о том, как я буду это делать.

Теперь вы хотите как можно больше использовать свой код. В этом случае я предлагаю выбрать фрагменты этого кода, написать версию Perl, а затем вызвать Perl script из основного script. Это позволит вам сделать преобразование небольшими шагами, утверждать, что преобразованная часть работает, и постепенно улучшать ваши знания в Perl.

Как вы можете вызывать внешние программы с Perl script, вы даже можете заменить некоторую большую логику на Perl и вызывать более мелкие скрипты оболочки (или другие команды) из Perl, чтобы сделать что-то, что вам пока не удобно, но конвертировать, Таким образом, у вас будет оболочка script, вызывающая perl script, вызывающую другую оболочку script. И, фактически, я сделал именно это с моим собственным первым Perl script.

Конечно, важно хорошо выбрать, что нужно преобразовать. Ниже я расскажу, сколько шаблонов, распространенных в сценариях оболочки, написано на Perl, так что вы можете идентифицировать их внутри своего script и создавать как можно больше патчей и папок.

Во-первых, оба скрипта Perl и сценарии Shell - это функции кода+. То есть все, что не является объявлением функции, выполняется в том порядке, в котором она встречается. Однако вам не нужно объявлять функции перед использованием. Это означает, что общая компоновка script может быть сохранена, хотя возможность сохранять вещи в памяти (например, целый файл или обработанную форму) позволяет упростить задачи.

Perl script, в Unix, начинается с чего-то вроде этого:

#!/usr/bin/perl

use strict;
use warnings;

use Data::Dumper;
#other libraries

(rest of the code)

Первая строка, очевидно, указывает на команды, которые будут использоваться для запуска script, как это делают обычные оболочки. Следующие две строки "use" делают язык более строгим, что должно уменьшить количество ошибок, с которыми вы сталкиваетесь, потому что вы плохо знаете язык (или просто сделали что-то неправильно). Третья строка использования импортирует функцию "Дампер" модуля "Данные". Это полезно для целей отладки. Если вы хотите узнать значение массива или хеш-таблицы, просто напечатайте Dumper (что угодно).

Обратите внимание, что комментарии похожи на строки оболочки, начиная с "#".

Теперь вы вызываете внешние программы и каналы из них или из них. Например:

open THIS, "cat $ARGV[0] |";

Это запустит cat, передав "$ARGV[0]", который будет равен $1 на shell - первый переданный ему аргумент. Результат этого будет передан в ваш Perl script через "THIS", который вы можете использовать для чтения с него, как я покажу позже.

Вы можете использовать "|" в начале или в конце строки, чтобы указать режим "pipe to" или "pipe from" и указать команду для запуска, и вы также можете использовать " > " или " → " в начале, чтобы открыть файл для записи с усечением или без него, "<" для явного указания открытия файла для чтения (по умолчанию) или "+ <" и "+ > " для чтения и записи. Обратите внимание, что позже будет обрезать файл первым.

Другой синтаксис "open", который позволит избежать проблем с файлами с такими символами в их именах, имеет режим открытия в качестве второго аргумента:

open THIS, "-|", "cat $ARGV[0]";

Это сделает то же самое. Режим "- |" означает "pipe from" и "| -" означает "pipe to". Остальные режимы можно использовать так, как они были (>, >>, <, +>, +<). Хотя есть больше, чем открывать, это должно быть достаточно для большинства вещей.

Но вы должны избегать вызова внешних программ как можно больше. Вы можете открыть файл напрямую, выполнив open THIS, "$ARGV[0]";, например, и получив гораздо лучшую производительность.

Итак, какие внешние программы вы могли бы вырезать? Ну, почти все. Но позвольте остаться с основами: кошка, grep, cut, head, tail, uniq, wc, sort.

CAT

Ну, об этом нельзя сказать много. Просто помните, что, если возможно, прочитайте файл только один раз и сохраните его в памяти. Если файл огромен, вы, конечно, этого не сделаете, но почти всегда есть способы избежать чтения файла более одного раза.

В любом случае основным синтаксисом для cat будет:

my $filename = "whatever";
open FILE, "$filename" or die "Could not open $filename!\n";
while(<FILE>) {
  print $_;
}
close FILE;

Это открывает файл и печатает все содержимое ( "while(<FILE>)" будет зацикливаться до EOF, назначая каждой строке "$_" ) и снова закрывая его.

Если бы я хотел направить вывод в другой файл, я мог бы сделать это:

my $filename = "whatever";
my $anotherfile = "another";
open (FILE, "$filename") || die "Could not open $filename!\n";
open OUT, ">", "$anotherfile" or die "Could not open $anotherfile for writing!\n";
while(<FILE>) {
  print OUT $_;
}
close FILE;

Это напечатает строку в файле, обозначенном "OUT". Вы можете использовать STDIN, STDOUT и STDERR в соответствующих местах, не открывая их в первую очередь. Фактически, "print" по умолчанию имеет значение STDOUT, а "die" по умолчанию - "STDERR".

Обратите внимание также на "or die ..." и "|| die ...". Операторы or и || означают, что он выполнит только следующую команду, если первая возвращает false (что означает пустую строку, нулевую ссылку, 0 и т.п.). Команда die останавливает script с сообщением об ошибке.

Основное различие между "or" и "||" является приоритетом. Если "or" было заменено на "||" в приведенных выше примерах, это не сработало бы, как ожидалось, потому что строка будет интерпретироваться как:

open FILE, ("$filename" || die "Could not open $filename!\n");

Это совсем не то, что ожидается. Поскольку "or" имеет более низкий приоритет, он работает. В строке, где используется "||", параметры в open передаются между скобками, что позволяет использовать "||".

Увы, есть что-то такое, что делает кошка:

while(<>) {
  print $_;
}

Это будет печатать все файлы в командной строке или что-либо, переданное через STDIN.

GREP

Итак, как будет работать наш "grep" script? Я буду считать "grep -E", потому что это проще в Perl, чем простой grep. В любом случае:

my $pattern = $ARGV[0];
shift @ARGV;
while(<>) {
        print $_ if /$pattern/o;
}

"o", переданный в $patttern, инструктирует Perl компилировать этот шаблон только один раз, тем самым увеличивая скорость. Не стиль "что-то, если cond". Это означает, что он выполнит только "что-то", если условие истинно. Наконец, только "/$pattern/" совпадает с "$_ =~ m/$pattern/", что означает сравнение $_ с указанным шаблоном регулярного выражения. Если вы хотите стандартное поведение grep, то есть просто подстроку, вы можете написать:

print $_ if $_ =~ "$pattern";

CUT

Обычно вам лучше использовать группы регулярных выражений, чтобы получить точную строку, чем разрезать. Что бы вы сделали с "sed", например. Во всяком случае, вот два способа воспроизведения разреза:

while(<>) {
  my @array = split ",";
  print $array[3], "\n";
}

Это даст вам четвертый столбец каждой строки, используя "," в качестве разделителя. Примечание @array и $array[3]. Символ @ означает "массив", который должен рассматриваться как массив, ну, массив. Он получит массив, состоящий из каждого столбца в текущей обрабатываемой строке. Затем значение $ sigil array[3] является скалярным значением. Он вернет колонку, о которой вы просите.

Это не очень хорошая реализация, хотя, поскольку "split" будет сканировать всю строку. Я однажды уменьшил процесс с 30 минут до 2 секунд, просто не используя split - линии, где довольно большой. Во всяком случае, нижеследующее имеет превосходную производительность, если ожидается, что строки будут большими, а нулевые столбцы будут низкими:

while(<>) {
  my ($column) = /^(?:[^,]*,){3}([^,]*),/;
  print $column, "\n";
}

Это позволяет использовать регулярные выражения для получения требуемой информации, и только это.

Если вы хотите позиционные столбцы, вы можете использовать:

while(<>) {
  print substr($_, 5, 10), "\n";
}

Будет напечатано 10 символов, начиная с шестого (опять же, 0 означает первый символ).

ГОЛОВКА

Это довольно просто:

my $printlines = abs(shift);
my $lines = 0;
my $current;
while(<>) {
  if($ARGV ne $current) {
    $lines = 0;
    $current = $ARGV;
  }
  print "$_" if $lines < $printlines;
  $lines++;
}

Что нужно отметить здесь. Я использую "ne" для сравнения строк. Теперь ARGV всегда будет указывать на текущий файл, будучи прочитанным, поэтому я отслеживаю их, чтобы перезапустить мой счет, как только я прочитаю новый файл. Также обратите внимание на более традиционный синтаксис "if", как и на постфиксированный.

Я также использую упрощенный синтаксис, чтобы получить количество строк для печати. Когда вы используете "shift" самостоятельно, он будет считать "shift @ARGV". Также обратите внимание, что сдвиг, помимо изменения @ARGV, вернет элемент, который был смещен из него.

Как и в случае с оболочкой, нет никакого различия между числом и строкой - вы просто используете его. Даже такие вещи, как "2" + "2", будут работать. Фактически, Perl еще более снисходителен, бодро рассматривая что-то не-число как 0, поэтому вы можете быть осторожны там.

Этот script очень неэффективен, хотя он читает ВСЕ файл, а не только нужные строки. Позвольте улучшить его и увидеть несколько важных ключевых слов в процессе:

my $printlines = abs(shift);
my @files;
if(scalar(@ARGV) == 0) {
  @files = ("-");
} else {
  @files = @ARGV;
}
for my $file (@files) {
  next unless -f $file && -r $file;
  open FILE, "<", $file or next;
  my $lines = 0;

  while(<FILE>) {
    last if $lines == $printlines;
    print "$_";
    $lines++;
  }

  close FILE;
}

Ключевые слова "следующий" и "последний" очень полезны. Во-первых, "next" скажет Perl вернуться к условию цикла, получив следующий элемент, если это применимо. Здесь мы используем его, чтобы пропустить файл, если он не является действительно файлом (а не каталогом) и доступен для чтения. Он также пропустит, если мы не сможем открыть файл даже тогда.

Затем "последний" используется, чтобы немедленно выпрыгнуть из цикла. Мы используем его, чтобы остановить чтение файла, как только мы достигнем необходимого количества строк. Правда, мы читаем одну строку слишком много, но "последняя" в этой позиции ясно показывает, что строки после нее не будут выполнены.

Существует также "повтор", который вернется к началу цикла, но не переоценивает условие и не получает следующий элемент.

TAIL

Я сделаю здесь небольшой трюк.

my $skiplines = abs(shift);
my @lines;
my $current = "";
while(<>) {
  if($ARGV ne $current) {
    print @lines;
    undef @lines;
    $current = $ARGV;
  }
  push @lines, $_;
  shift @lines if $#lines == $skiplines;
}
print @lines;

Хорошо, я сочетаю "push", который добавляет значение в массив, с "shift", который берет что-то с начала массива. Если вам нужен стек, вы можете использовать push/pop или shift/unshift. Смешайте их, и у вас очередь. Я сохраняю свою очередь в количестве не более 10 элементов с помощью $#lines, которая даст мне индекс последнего элемента в массиве. Вы также можете получить количество элементов в @lines с помощью scalar(@lines).

UNIQ

Теперь uniq устраняет повторяющиеся последовательные строки, что должно быть легко с тем, что вы видели до сих пор. Поэтому я уничтожу все из них:

my $current = "";
my %lines;
while(<>) {
  if($ARGV ne $current) {
    undef %lines;
    $current = $ARGV;
  }
  print $_ unless defined($lines{$_});
  $lines{$_} = "";
}

Теперь я сохраняю весь файл в памяти, внутри %lines. Использование знака % указывает, что это хеш-таблица. Я использую строки как ключи и не сохраняю ничего как значение - поскольку я не заинтересован в значениях. Я проверяю, где существует ключ с "определенным ($ lines {$ _})", который будет проверять, определено ли значение, связанное с этим ключом; ключевое слово "если" работает так же, как "если", но с противоположным эффектом, поэтому оно печатает только строку, если строка НЕ ​​определена.

Обратите также внимание на синтаксис $lines{$_} = "" как способ сохранить что-то в хеш-таблице. Обратите внимание на использование {} для хэш-таблицы, в отличие от [] для массивов.

WC

Это фактически будет использовать много вещей, которые мы видели:

my $current;
my %lines;
my %words;
my %chars;
while(<>) {
  $lines{"$ARGV"}++;
  $chars{"$ARGV"} += length($_);
  $words{"$ARGV"} += scalar(grep {$_ ne ""} split /\s/);
}

for my $file (keys %lines) {
  print "$lines{$file} $words{$file} $chars{$file} $file\n";
}

Три новые вещи. Два - это оператор "+ =", который должен быть очевиден, и выражение "для". В принципе, "for" присваивает каждому элементу массива указанную переменную. "Мой" есть, чтобы объявить переменную, хотя она не нужна, если объявлена ​​ранее. Я мог бы иметь переменную @array внутри этих скобок. Выражение "keys% lines" будет возвращаться в виде массива, который они имеют (имена файлов), которые существуют для хеш-таблицы "% строк". Остальное должно быть очевидно.

Третья вещь, которую я фактически добавила только для пересмотра ответа, - это "grep" . Формат здесь:

grep { code } array

Он будет запускать "код" для каждого элемента массива, передавая элемент как "$ _". Затем grep вернет все элементы, для которых код оценивается как "true" (не 0, а не "" и т.д.). Это позволяет избежать подсчета пустых строк из последовательных пробелов.

Подобно "grep" есть "карта", которую я не буду здесь демонстрировать. Вместо фильтрации он будет возвращать массив, сформированный по результатам "кода" для каждого элемента.

SORT

Наконец, сортировка. Это тоже легко:

my @lines;
my $current = "";
while(<>) {
  if($ARGV ne $current) {
    print sort @lines;
    undef @lines;
    $current = $ARGV;
  }
  push @lines, $_;
}
print sort @lines;

Здесь "сортировка" сортирует массив. Обратите внимание, что сортировка может получить функцию для определения критериев сортировки. Например, если бы я хотел сортировать числа, я мог бы это сделать:

my @lines;
my $current = "";
while(<>) {
  if($ARGV ne $current) {
    print sort @lines;
    undef @lines;
    $current = $ARGV;
  }
  push @lines, $_;
}
print sort {$a <=> $b} @lines;

Здесь "$a" и "$b" получают элементы, которые нужно сравнить. "<=>" возвращает -1, 0 или 1 в зависимости от того, является ли число меньше, равным или большим, чем другое. Для строк "cmp" делает то же самое.

ОБРАБОТКА ФАЙЛОВ, ДИРЕКТОРИЙ И ДРУГИХ СТУДЕНТОВ

Что касается остальных, основные математические выражения должны быть легко понятны. Вы можете проверить определенные условия на файлы таким образом:

for my $file (@ARGV) {
  print "$file is a file\n" if -f "$file";
  print "$file is a directory\n" if -d "$file";
  print "I can read $file\n" if -r "$file";
  print "I can write to $file\n" if -w "$file";
}

Я не пытаюсь быть exaustive здесь, есть много других таких тестов. Я также могу делать шаблоны "glob", такие как shell "*" и "?", Например:

for my $file (glob("*")) {
  print $file;
  print "*" if -x "$file" && ! -d "$file";
  print "/" if -d "$file";
  print "\t";
}

Если вы комбинировали это с "chdir", вы можете также эмулировать "find":

sub list_dir($$) {
  my ($dir, $prefix) = @_;
  my $newprefix = $prefix;
  if ($prefix eq "") {
    $newprefix = $dir;
  } else {
    $newprefix .= "/$dir";
  }
  chdir $dir;
  for my $file (glob("*")) {
    print "$prefix/" if $prefix ne "";
    print "$dir/$file\n";
    list_dir($file, $newprefix) if -d "$file";
  }
  chdir "..";
}

list_dir(".", "");

Здесь мы видим, наконец, функцию. Функция объявляется с синтаксисом:

sub name (params) { code }

Строго говоря, "(params)" является необязательным. Объявленный параметр, который я использовал, "($$)" означает, что я получаю два скалярных параметра. Я мог бы иметь "@" или "%" там. Массив "@_" имеет все переданные параметры. Строка "my ($dir, $prefix) = @_" - это просто простой способ присвоения первых двух элементов этого массива переменным $dir и $prefix.

Эта функция ничего не возвращает (это процедура, действительно), но вы можете иметь функции, возвращающие значения, просто добавляя к ней "return something;" и возвращайте "что-то".

Остальная часть должна быть довольно очевидной.

СМЕШАННОЕ ВСЕ

Теперь я приведу более примерный пример. Я покажу плохой код, чтобы объяснить, что с ним не так, а затем показать лучший код.

В этом первом примере у меня есть два файла, файл names.txt, имена и телефонные номера, system.txt, с системами и имя ответственного за них. Вот они:

names.txt

John Doe, (555) 1234-4321
Jane Doe, (555) 5555-5555
The Boss, (666) 5555-5555

systems.txt

Sales, Jane Doe
Inventory, John Doe
Payment, That Guy

Затем я хочу напечатать первый файл, при этом система добавляется к имени человека, если это лицо несет ответственность за эту систему. Первая версия может выглядеть так:

#!/usr/bin/perl

use strict;
use warnings;

open FILE, "names.txt";

while(<FILE>) {
  my ($name) = /^([^,]*),/;
  my $system = get_system($name);
  print $_ . ", $system\n";
}

close FILE;

sub get_system($) {
  my ($name) = @_;
  my $system = "";

  open FILE, "systems.txt";

  while(<FILE>) {
    next unless /$name/o;
    ($system) = /([^,]*)/;
  }

  close FILE;

  return $system;
}

Этот код не работает. Perl будет жаловаться, что функция была использована слишком рано для проверки прототипа, но это просто предупреждение. Он выдаст ошибку в строке 8 (первый цикл while), жалуясь на чтение строки закрытой дескриптора файла. Здесь произошло то, что "FILE" является глобальным, поэтому функция get_system меняет его. Переписываем его, фиксируя обе вещи:

#!/usr/bin/perl

use strict;
use warnings;

sub get_system($) {
  my ($name) = @_;
  my $system = "";

  open my $filehandle, "systems.txt";

  while(<$filehandle>) {
    next unless /$name/o;
    ($system) = /([^,]*)/;
  }

  close $filehandle;

  return $system;
}

open FILE, "names.txt";

while(<FILE>) {
  my ($name) = /^([^,]*),/;
  my $system = get_system($name);
  print $_ . ", $system\n";
}

close FILE;

Это не даст никаких ошибок или предупреждений, и это не сработает. Он возвращает только системы, но не имена и номера телефонов! Что случилось? Ну, что случилось, мы делаем ссылку на "$_" после вызова get_system, но, читая файл, get_system перезаписывает значение $_!

Чтобы этого избежать, мы сделаем $_ локальным внутри get_system. Это даст ему локальную область, и исходное значение будет восстановлено после возврата из get_system:

#!/usr/bin/perl

use strict;
use warnings;

sub get_system($) {
  my ($name) = @_;
  my $system = "";
  local $_;

  open my $filehandle, "systems.txt";

  while(<$filehandle>) {
    next unless /$name/o;
    ($system) = /([^,]*)/;
  }

  close $filehandle;

  return $system;
}

open FILE, "names.txt";

while(<FILE>) {
  my ($name) = /^([^,]*),/;
  my $system = get_system($name);
  print $_ . ", $system\n";
}

close FILE;

И это все еще не работает! Он печатает новую строку между именем и системой. Ну, Perl читает строку, включая любую новую строку, которую она может иметь. Существует чистая команда, которая удаляет строки из строк, "chomp", которые мы будем использовать для устранения этой проблемы. И поскольку не у каждого имени есть система, мы также можем избежать печати запятой, когда это произойдет:

#!/usr/bin/perl

use strict;
use warnings;

sub get_system($) {
  my ($name) = @_;
  my $system = "";
  local $_;

  open my $filehandle, "systems.txt";

  while(<$filehandle>) {
    next unless /$name/o;
    ($system) = /([^,]*)/;
  }

  close $filehandle;

  return $system;
}

open FILE, "names.txt";

while(<FILE>) {
  my ($name) = /^([^,]*),/;
  my $system = get_system($name);
  chomp;
  print $_;
  print ", $system" if $system ne "";
  print "\n";
}

close FILE;

Это работает, но это также оказывается ужасно неэффективным. Мы читаем весь системный файл для каждой строки в файле имен. Чтобы этого избежать, мы будем считывать все данные из систем один раз, а затем использовать их для обработки имен.

Теперь, иногда файл настолько велик, что вы не можете его прочитать в памяти. Когда это произойдет, вы должны попытаться прочитать в памяти любой другой файл, необходимый для его обработки, чтобы вы могли делать все за один проход для каждого файла. В любом случае, вот первая оптимизированная версия:

#!/usr/bin/perl

use strict;
use warnings;

our %systems;
open SYSTEMS, "systems.txt";
while(<SYSTEMS>) {
  my ($system, $name) = /([^,]*),(.*)/;
  $systems{$name} = $system;
}
close SYSTEMS;

open NAMES, "names.txt";
while(<NAMES>) {
  my ($name) = /^([^,]*),/;
  chomp;
  print $_;
  print ", $systems{$name}" if defined $systems{$name};
  print "\n";
}
close NAMES;

К сожалению, он не работает. Система никогда не появляется! Что произошло? Итак, рассмотрим, что содержит < %systems ", используя Data::Dumper:

#!/usr/bin/perl

use strict;
use warnings;

use Data::Dumper;

our %systems;
open SYSTEMS, "systems.txt";
while(<SYSTEMS>) {
  my ($system, $name) = /([^,]*),(.*)/;
  $systems{$name} = $system;
}
close SYSTEMS;

print Dumper(%systems);

open NAMES, "names.txt";
while(<NAMES>) {
  my ($name) = /^([^,]*),/;
  chomp;
  print $_;
  print ", $systems{$name}" if defined $systems{$name};
  print "\n";
}
close NAMES;

Результат будет примерно таким:

$VAR1 = ' Jane Doe';
$VAR2 = 'Sales';
$VAR3 = ' That Guy';
$VAR4 = 'Payment';
$VAR5 = ' John Doe';
$VAR6 = 'Inventory';
John Doe, (555) 1234-4321
Jane Doe, (555) 5555-5555
The Boss, (666) 5555-5555

Те $VAR1/$VAR2/etc таковы, как Dumper отображает хеш-таблицу. Нечетные числа - это ключи, а последующие четные числа - значения. Теперь мы видим, что каждое имя в %systems имеет следующее пространство! Глупая ошибка регулярного выражения, пусть исправить:

#!/usr/bin/perl

use strict;
use warnings;

our %systems;
open SYSTEMS, "systems.txt";
while(<SYSTEMS>) {
  my ($system, $name) = /^\s*([^,]*?)\s*,\s*(.*?)\s*$/;
  $systems{$name} = $system;
}
close SYSTEMS;

open NAMES, "names.txt";
while(<NAMES>) {
  my ($name) = /^\s*([^,]*?)\s*,/;
  chomp;
  print $_;
  print ", $systems{$name}" if defined $systems{$name};
  print "\n";
}
close NAMES;

Итак, здесь мы агрессивно удаляем любые пробелы с начала или конца имени и системы. Существуют и другие способы формирования этого регулярного выражения, но это не относится к делу. Есть еще одна проблема с этим script, который вы увидите, если ваши файлы "names.txt" и/или "system.txt" имеют пустую строку в конце. Предупреждения выглядят следующим образом:

Use of uninitialized value in hash element at ./exemplo3e.pl line 10, <SYSTEMS> line 4.
Use of uninitialized value in hash element at ./exemplo3e.pl line 10, <SYSTEMS> line 4.
John Doe, (555) 1234-4321, Inventory
Jane Doe, (555) 5555-5555, Sales
The Boss, (666) 5555-5555
Use of uninitialized value in hash element at ./exemplo3e.pl line 19, <NAMES> line 4.

Что произошло, так это то, что при обработке пустой строки ничего не попадало в переменную "$name". Существует много способов, но я выбираю следующее:

#!/usr/bin/perl

use strict;
use warnings;

our %systems;
open SYSTEMS, "systems.txt" or die "Could not open systems.txt!";
while(<SYSTEMS>) {
  my ($system, $name) = /^\s*([^,]+?)\s*,\s*(.+?)\s*$/;
  $systems{$name} = $system if defined $name;
}
close SYSTEMS;

open NAMES, "names.txt" or die "Could not open names.txt!";
while(<NAMES>) {
  my ($name) = /^\s*([^,]+?)\s*,/;
  chomp;
  print $_;
  print ", $systems{$name}" if defined($name) && defined($systems{$name});
  print "\n";
}
close NAMES;

В регулярных выражениях требуется, по крайней мере, один символ для имени и системы, и мы проверяем, определено ли "$name", прежде чем мы его используем.

Заключение

Итак, вот основные инструменты для перевода оболочки script. Вы можете сделать MUCH больше с Perl, но это не ваш вопрос, и он все равно не поместится.

Как основной обзор некоторых важных тем,

  • Perl script, который может быть атакован хакерами, должен быть запущен с параметром -T, так что Perl будет жаловаться на любой уязвимый ввод, который не был должным образом обработан.

  • Существуют библиотеки, называемые модулями, для доступа к базе данных, обработки XML и cia, Telnet, HTTP и других протоколов. На самом деле есть мириады модулей, которые можно найти на CPAN.

  • Как упоминалось кем-то другим, если вы используете AWK или SED, вы можете перевести их на Perl с A2P и S2P.

  • Perl может быть написан объектно-ориентированным способом.

  • Существует несколько версий Perl. На момент написания этой статьи, стабильный - 5.8.8, и доступно 5.10.0. Существует также Perl 6 в разработке, но опыт научил всех не ждать слишком нетерпеливо для него.

Существует бесплатная, хорошая, практичная, жесткая и быстрая книга о Perl, называемая Изучение Perl Hard Way. Этот стиль похож на этот самый ответ. Это может быть хорошее место, чтобы идти отсюда.

Надеюсь, это помогло.

ОТКАЗ

Я НЕ пытаюсь учить Perl, и вам нужно будет иметь хотя бы какой-то справочный материал. Существуют рекомендации относительно хороших привычек Perl, таких как использование "use strict;" и "use warnings;" в начале script, чтобы сделать его менее снисходительным к плохо написанному коду или использованию STDOUT и STDERR на линиях печати, чтобы указать правильный выходной канал.

Это то, с чем я согласен, но я решил, что это отвлечет основную цель отображения шаблонов для общих утилит оболочки script.

Ответ 2

Я не знаю, что в вашей оболочке script, но не забывайте, что есть такие инструменты, как

  • a2p - awk-to-perl
  • s2p - sed-to-perl

и, возможно, больше. Стоит взглянуть вокруг.

Вы можете обнаружить, что из-за мощности/функций Perl это не такая большая работа, что вы, возможно, прыгали через обручи с различными bash функциями и служебными программами, чтобы делать что-то, что выходит из Perl изначально.

Как и любой проект миграции, полезно использовать некоторые законченные регрессионные тесты для обоих решений, поэтому, если у вас их нет, я бы сгенерировал их первым.

Ответ 3

Я удивлен, что никто еще не упомянул Shell-модуль, который входит в состав ядра Perl, который позволяет выполнять внешние команды, используя синтаксис функции-вызова. Например (адаптировано из резюме):

use Shell qw(cat ps cp);
$passwd = cat '</etc/passwd';
@pslines = ps '-ww';
cp "/etc/passwd", "/tmp/passwd";

Если вы используете parens, вы можете даже вызвать другие программы в $PATH, которые вы не указали в строке use, например:

gcc('-o', 'foo', 'foo.c');

Обратите внимание, что Shell собирает подпроцесс STDOUT и возвращает его как строку или массив. Это упрощает создание сценариев, но это не самый эффективный способ выхода и может вызвать проблемы, если вы полагаетесь на вывод команды без буфера.

В модуле упоминаются некоторые недостатки, такие как внутренние команды оболочки (например, cd) не могут быть вызваны с использованием того же синтаксиса. Фактически они рекомендуют, чтобы модуль не использовался для производственных систем! Но это, безусловно, может быть полезным костылем, чтобы опираться, пока вы не передадите свой код на "правильный" Perl.

Ответ 4

Встроенная оболочка thingy называется system. Если у вас есть пользовательские функции, которые вы пытаетесь открыть для Perl, вам не повезло. Однако вы можете запускать короткие бит оболочки, используя ту же среду, что и ваша работающая программа Perl. Вы также можете постепенно заменить части оболочки script на Perl. Начните писать модуль, который реплицирует функциональность оболочки script и вставляет Perly биты в оболочку script, пока у вас в конечном итоге не будет в основном Perl.

Нет переводчика shell-to-Perl. Был длинный анекдот о переводчике csh-to-Perl, который вы могли бы отправить по электронной почте на ваш script, но это был просто Том Кристиансен, переводящий его для вас, чтобы показать вам, как классный Perl вернулся в начале 90-х. Рэндал Шварц загрузил переводчика sh-to-Perl, но вы должны проверить дату загрузки: это был апрельский дурак. Его script просто завернул все в system.

Что бы вы ни делали, не теряйте исходную оболочку script.:)

Ответ 5

Я согласен с тем, что изучение Perl и попытка написать Perl вместо оболочки для большего блага. Я сделал передачу один раз с помощью функции "Заменить" Notepad ++.

Однако у меня была аналогичная проблема с первоначально спрошенной, когда я пытался создать оболочку Perl вокруг оболочки script (которая могла ее выполнить).

Я пришел со следующим кодом, который работает в моем случае.

Это может помочь.

#!perl
use strict;
use Data::Dumper;
use Cwd;

#Variables read from shell
our %VAR;

open SH, "<$ARGV[0]" or die "Error while trying to read $ARGV[0] ($!)\n";
my @SH=<SH>;
close SH;

sh2perl(@SH);


#Subroutine to execute shell from Perl (read from array)
sub sh2perl {
    #Variables
    my %case; #To store data from conditional block of "case"
    my %if; #To store data from conditional block of "if"

    foreach my $line (@_) {
        #Remove blanks at the beginning and EOL character
        $line=~s/^\s*//;
        chomp $line;

        #Comments and blank lines
        if ($line=~/^(#.*|\s*)$/) {
            #Do nothing
        }

        #Conditional block - Case
        elsif ($line=~/case.*in/..$line=~/esac/) {
            if ($line=~/case\s*(.*?)\s*\in/) {
                $case{'var'}=transform($1);
            } elsif ($line=~/esac/) {
                delete $case{'curr_pattern'};
                #Run conditional block
                my $case;
                map { $case=$_ if $case{'var'}=~/$_/ } @{$case{'list_patterns'}};
                $case ? sh2perl(@{$case{'patterns'}->{$case}}) : sh2perl(@{$case{'patterns'}->{"*"}});
            } elsif ($line=~/^\s*(.*?)\s*\)/) {
                $case{'curr_pattern'}=$1;
                push(@{$case{'list_patterns'}}, $case{'curr_pattern'}) unless ($line=~m%\*\)%)
            } else {
                push(@{$case{'patterns'}->{ $case{'curr_pattern'} }}, $line);
            }
        }

        #Conditional block - if
        elsif ($line=~/^if/..$line=~/^fi/) {
            if ($line=~/if\s*\[\s*(.*\S)\s*\];/) {
                $if{'condition'}=transform($1);
                $if{'curr_cond'}="TRUE";
            } elsif ($line=~/fi/) {
                delete $if{'curr_cond'};
                #Run conditional block
                $if{'condition'} ? sh2perl(@{$if{'TRUE'}}) : sh2perl(@{$if{'FALSE'}});
            } elsif ($line=~/^else/) {
                $if{'curr_cond'}="FALSE";
            } else {
                push(@{$if{ $if{'curr_cond'} }}, $line);
            }
        }

        #echo
        elsif($line=~/^echo\s+"?(.*?[^"])"?\s*$/) {
            my $str=$1;
            #echo with redirection
            if ($str=~m%[>\|]%) { 
                eval { system(transform($line)) };
                if ([email protected]) { warn "Error while evaluating $line: [email protected]\n"; }
            #print new line
            } elsif ($line=~/^echo ""$/) {
                print "\n";
            #default
            } else {
                print transform($str),"\n";
            }
        }

        #cd
        elsif($line=~/^\s*cd\s+(.*)/) {
            chdir $1;
        }

        #export
        elsif($line=~/^export\s+((\w+).*)/) {
            my ($var,$exported)=($2,$1);
            if ($exported=~/^(\w+)\s*=\s*(.*)/) {
                while($exported=~/(\w+)\s*=\s*"?(.*?\S)"?\s*(;(?:\s*export\s+)?|$)/g) { $VAR{$1}=transform($2); }
            }
            # export($var,$VAR{$var});
            $ENV{$var}=$VAR{$var};
            print "Exported variable $var = $VAR{$var}\n";
        }


        #Variable assignment
        elsif ($line=~/^(\w+)\s*=\s*(.*)$/) {
            $1 eq "" or $VAR{$1}=""; #Empty variable
            while($line=~/(\w+)\s*=\s*"?(.*?\S)"?\s*(;|$)/g) {
                $VAR{$1}=transform($2);
            }
        }

        #Source
        elsif ($line=~/^source\s*(.*\.sh)/) {
            open SOURCE, "<$1" or die "Error while trying to open $1 ($!)\n";
            my @SOURCE=<SOURCE>;
            close SOURCE;
            sh2perl(@SOURCE);
        }


        #Default (assuming running command)
        else {
            eval { map { system(transform($_)) } split(";",$line); };
            if ([email protected]) { warn "Error while doing system on \"$line\": [email protected]\n"; }
        }

    }
}


sub transform {
    my $src=$_[0];

    #Variables $1 and similar
    $src=~s/\$(\d+)/$ARGV[$1-1]/ge;

    #Commands stored in variables "$(<cmd>)"
    eval {
        while ($src=~m%\$\((.*)\)%g) {
            my ($cmd,$new_cmd)=($1,$1);
            my $curr_dir=getcwd;
            $new_cmd=~s/pwd/echo $curr_dir/g;
            $src=~s%\$\($cmd\)%`$new_cmd`%e;
            chomp $src;
        }
    };
    if ([email protected]) { warn "Wrong assessment for variable $_[0]:\n=> [email protected]\n"; return "ERROR"; }

    #Other variables
    $src=~s/\$(\w+)/$VAR{$1}/g;

    #Backsticks
    $src=~s/`(.*)`/`$1`/e;

    #Conditions
    $src=~s/"(.*?)"\s*==\s*"(.*?)"/"$1" eq "$2" ? 1 : 0/e;
    $src=~s/"(.*?)"\s*!=\s*"(.*?)"/"$1" ne "$2" ? 1 : 0/e;
    $src=~s/(\S+)\s*==\s*(\S+)/$1 == $2 ? 1 : 0/e;
    $src=~s/(\S+)\s*!=\s*(\S+)/$1 != $2 ? 1 : 0/e;

    #Return Result
    return $src;
}

Ответ 6

Ну и hellip;

Вы можете запустить свой "Perl" script с помощью

#!/bin/bash

Затем, предположив, что bash был установлен в этом месте, perl будет автоматически вызывать интерпретатор bash для его запуска.

Изменить: Или, возможно, ОС перехватит вызов и остановит его доступ к Perl. Мне сложно найти документацию о том, как это работает. Комментарии к документации будут приветствоваться.