Использование регулярного выражения для извлечения совпадающего шаблона из строки и назначения его переменной с использованием perl

Question

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

Вот точная ситуация. Я использую perl и regex для извлечения идентификатора курса из университетского каталога и назначения его переменной. Пожалуйста, обратите внимание на следующее:

• BIO-2109-01 (12345) Введение в биологию
• CHM-3501-F2-01 (54321) Введение в химии
• IDS-3250-01 (98765) История США (1860-2000)
• SPN-1234-02-F1 (45678) История Испании (1900-2010)

типичный формат [сечение имя-курс] [(courseID)] [ название курса]

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

Мой подход состоял в том, чтобы использовать поиск и замену, чтобы заменить все, что не соответствует этому с помощью '', а затем сохранить то, что осталось (идентификатор курса) для переменной. Вот несколько примеров того, что я пробовал следующее:

$string = "BIO-2109-01 (12345) Introduction to Biology"; 
($courseID = $string) =~ s/[^\d\d\d\d\d]//g; 
print $courseID; 

Результат: 21090112345 --- печатая сечение-название курса и courseID

$string = "BIO-2109-01 (12345) Introduction to Biology"; 
$($courseID = $string) =~ s/[^\b\(\d{5}\)]\b//g; 
print $courseID; 

Результат: 210901 (12345) - - печать сечения, название курса, скобки, и courseID

Так что я не очень везло с поиском и заменить - однако я нашел этот самородок:

\(([^\)]+)\) 

http://regexr.com/, который будет соответствовать разделу parens. Однако он также будет соответствовать нескольким паранам, включая, например, (abc).

Я не совсем уверен, что в этот момент, как сделать что-то вроде этого:

$string = "BIO-2109-01 (12345) Introduction to Biology"; 
($courseID = $string) =~ [magicRegex_goes_here]; 
print courseID;  

результат 12345

ИЛИ, лучше:

$string = IDS-3250-01 (98765) History of US (1860-2000) 
($courseID = $string) =~ [magicRegex_goes_here]; 
print courseID; 

результат 98765

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

UPDATE

use warnings 'all'; 
use strict; 
use feature 'say'; 

my $file = './data/enrollment.csv';  #File this script generates 
my $course = "";       #Complete course string [name-of-course] [(courseID)] [course_name] 
my @arrayCourses = "";     #Array of courseIDs 
my $i = "";        #i in for loop 
my $courseID = "";      #Extracted course ID 
my $userName = "";      #Username of person we are enrolling 
my $action = "add,";      #What we are doing to user 
my $permission = "teacher,";    #What permissions to assign to user 
my $stringToPrint = "";     #Concatinated string to write to file 
my $n = "\n";       #\n 
my $c = ",";        #, 

#BEGIN PROGRAM 

print "Enter the username \n"; 

chomp($userName = <STDIN>);    #Get the enrollee username from user 

print "\n"; 

print "Enter course name and press enter. Enter 'x' to end. \n"; #prompt for course names 

while ($course ne 'x') { 
     chomp($course = <STDIN>); 
     if ($course ne "x") { 
       if (($courseID) = ($course =~ /[^(]+\(([^)]+)\)/)) {  #nasty regex to extract courseID - thnx PerlDuck and zdim 
         push @arrayCourses, $courseID;     #put the courseID into array 
       } 
       else { 
         print "Cannot process last entry check it"; 
       } 
     } 
     else { 
       last; 
     } 
} 

shift @arrayCourses;      #Remove first entry from array - add,teacher,,username 

open(my $fh,'>', $file);     #open file 

for $i (@arrayCourses)     #write array to file 
{ 
     $stringToPrint= join "", $action, $permission, $i, $c, $userName, $n ; 
     print $fh $stringToPrint; 
} 

close $fh; 

Это сделает это! Предложения и улучшения всегда приветствуются!Благодаря @PerlDuck и @zdim

Answer 1

Поскольку вы прибиты формат

my ($section, $id, $name) = 
    $string =~ /^\s* ([^(]+) \(\s* ([^)]+) \)\s* (.+) $/x; 

Ключевым моментом здесь является инвертированный символьный класс, [^...], который соответствует любому символу, кроме тех, которые перечислены в после ^ (что делает его «отрицательным»). Неэкранированная скобка фиксирует совпадение, за исключением внутри класса символов [], где они взяты как буквальные.

Он сначала соответствует всем последовательным символам, отличным от (, поэтому до первого (, что захвачено парой () вокруг него. Затем все остальные, кроме ), поэтому вплоть до первого закрывающего пара, также захватываются собственной парой (). Это происходит между буквальными скобками \(... \), которые находятся за пределами (), так как мы не хотим, чтобы они были захвачены. Затем все остальное захватывается, (.+), требующим хотя бы некоторых символов с + означает один или больше. Обратите внимание, что это могут быть пробелы. Мы исключаем возможное начальное белое пространство из первого захвата, сопоставляя его конкретно перед захватывающей скобкой и извлекаем (некоторые из) возможных пространств вокруг круглых скобок id.

Модификатор /x позволяет использовать пробелы (и комментарии и новые строки) внутри, что помогает реадаптировать. Оператор match возвращает список всех совпадений, которые мы присваиваем переменным. Обратите внимание, что даже если есть только одно совпадение, оно все равно возвращает (это как) список. См. Regular Expressions Tutorial (perlretut).

Тогда, при условии, что у вас есть каталог в файле

use warnings 'all'; 
use strict; 
use feature 'say'; 

my $file = 'catalog.txt'; 

open my $fh, '<', $file or die "Can't open $file: $!"; 

while (my $line = <$fh>) 
{ 
    next if $line =~ /^\s*$/; # skip empty lines 

    # Strip leading and trailing white space 
    $line =~ s{^\s*|\s*$}{}g; 

    my ($section, $id, $name) = 
     $line =~ /^ ([^(]+) \(\s* ([^)]+) \)\s* (.+) $/x 
      or do { 
       warn "Error with expected format -- "; 
       next; 
      }; 

    say "$section, $id, $name"; 
} 
close $fh; 

Я использую s{}{} разделители с момента подсветки синтаксиса s/// путайте разметку с помощью этого шаблона, который также является хорошей демонстрацией, так как они иногда помогают читаемости много.

Вы сохранили бы полученные переменные в подходящей структуре данных. Любая комбинация массивов и хешей (и их ссылок) приходит на ум, в зависимости от того, что с ними нужно сделать позже. См. Cookbook of Data Structures (perldsc).

Примечание относительно обработки ошибок. Поскольку ни один из совпадений не включает * (разрешение ноль совпадений - ничего), если какой-либо компонент вашего формата не так, как ожидается, не будет никакого совпадения, и мы получим сообщение об ошибке. .+ чрезвычайно разрешительный, но по-прежнему требуется что-то быть там. Вот почему конечное пространство сначала разделяется, так что последний шаблон (.+) не может быть удовлетворен только пробелами.

Если единственная цель является курс идентификатор и мы определенный что первая скобка вокруг него

my ($id) = $line =~/\(\s* ([^)]+) \) /x or do { ... }; 

теперь только нужно, чтобы соответствовать и захватить среднюю часть, то внутри скобок.

Answer 2

#!/usr/bin/env perl 

use strict; 
use warnings; 

while(my $line = <DATA>) { 
    if (my ($courseID) = ($line =~ /[^(]+\(([^)]+)\)/)) { 
     print "course-ID = $courseID; -- line was $line"; 
    } 
} 

__DATA__ 
BIO-2109-01 (12345) Introduction to Biology 
CHM-3501-F2-01 (54321) Introduction to Chemistry 
IDS-3250-01 (98765) History of US (1860-2000) 
SPN-1234-02-F1 (45678) Spanish History (1900-2010) 

Выход:

course-ID = 12345; -- line was BIO-2109-01 (12345) Introduction to Biology 
course-ID = 54321; -- line was CHM-3501-F2-01 (54321) Introduction to Chemistry 
course-ID = 98765; -- line was IDS-3250-01 (98765) History of US (1860-2000) 
course-ID = 45678; -- line was SPN-1234-02-F1 (45678) Spanish History (1900-2010) 

Узор я использовал, /[^(]+\(([^)]+)\)/, также может быть записана в виде

/ [^(]+  # 1 or more characters that are not a '(' 
    \(  # a literal '('. You must escape that because you don't want 
      # to start it a capture group. 
    ([^)]+) # 1 or more chars that are not a ')'. 
      # The sorrounding '(' and ')' capture this match 
    \)  # a literal ')' 
/x 

Модификатор /x позволяет вставлять пробелы, комментарии, и даже новые строки прямо в шаблоне.

---

На всякий случай вы не уверены в том, что /x. Вы действительно можете написать:

while(my $line = <DATA>) { 
    if (my ($courseID) = ($line =~/[^(]+ # … 
            \(  # … 
            ([^)]+) # … 
            \)  # … 
            /x)) { 
     print "course-ID = $courseID; -- line was $line"; 
    } 
} 

Это, вероятно, не приятно читать но вы также можете сохранить регулярное выражение в отдельной переменной:

my $pattern = 
    qr/ [^(]+  # 1 or more characters that are not a '(' 
     \(  # a literal '(' (you must escape it) 
     ([^)]+) # 1 or more chars that are not a ')'. 
        # The sorrounding '(' and ')' capture this match 
     \)  # a literal ')' 
     /x; 

И потом:

if (my ($courseID) = ($line =~ $pattern)) { 
    … 
}