2013-11-14 2 views
1

Я пытаюсь написать скрипт perl для генерации xml из произвольных табличных данных, которые доступны в текстовом файле. Для обсуждения ради позволяет сказать, что я хочу взять вывод команды LinuxЕсть ли способ эффективно идентифицировать/извлечь заголовки из таблицы: Perl

df -k 

и разобрать его на мой PERL скрипт и сгенерировать XML на лету.

Образец check_disk_usage.log

Filesystem   1K-blocks  Used Available Use% Mounted on 
/dev/sda3    56776092 5431448 48413988 11%/
/dev/sda1    101086  18993  76874 20% /boot 
tmpfs     2021888   0 2021888 0% /dev/shm 

Теперь для того, чтобы генерировать XML, мне нужно, чтобы извлечь заголовки из этой таблицы и хранить их в массив для последующего использования (они будут использоваться в качестве открывающих и закрывающих тегов в XML) Как я это делаю:

open my $file, '<', "$dir/check_disk_usage.log"; 
my $firstLine = <$file>; 
close $file; 

my (@header) = $firstLine =~ /(\S+)/g; 

т.е. я ищу всех один или более непробельных шаблонов (фактически слово) и сохранение их в виде массива. Это работает прекрасно до тех пор, как имена заголовков следуют моделям, чтобы быть единственным словом

eg Filesystem,1K-blocks,Used etc 

Однако, когда имя заголовка са «Установленные на» встречается, он сломается, как и «конный» и «на "будут рассматриваться как разные шаблоны и, следовательно, будут храниться как разные элементы массива. Есть ли способ эффективно идентифицировать/извлечь заголовки из таблицы.

PS: Я знаю, я мог бы использовать awk, чтобы что-то заменить, и затем проанализировать файл. Но тогда мне нужно будет знать «оскорбительный шаблон» перед рукой, что невозможно, поскольку я планирую написать этот скрипт для любых произвольных табличных данных.

PSS: Хотя я работаю с Perl, я открыт для других решений, а также (например, PHP и т.д.)

Цените вашу помощь.

+0

Я думаю, что «установлен на» - это единственный «плохой» случай, который вы найдете. В имени нет имен файлов, поэтому вы можете даже жестко определить этот случай. – fedorqui

+0

Если данные действительно произвольны и не могут быть захвачены общими правилами, то вы являетесь SOL без применения соответствующих правил крайнего случая. Лично я бы определил правила * за * выходной формат. – user2864740

+1

'unpack' и' substr' обрабатывают данные фиксированной ширины. – TLP

ответ

1

Из взглядов ваших данных значения разделяются, где каждая строка имеет пробелы на нем. Если некоторые строки имеют пробелы, а некоторые - нет, это не является разделителем. Это приводит к использованию маски для определения места разбиения заголовка.

Любопытное некрасиво, но:

#!/usr/bin/perl 
# Read the file provided on STDIN and then determine the delimiters, 
# printing the individual elements per line. 

my @lines = map { chomp; $_ } <>; 

# The mask indicates if a character has ever been a NON whitespace character 
my @mask =(); 

foreach my $line (@lines) { 
    my @line = split //, $line; 
    foreach my $index (0..$#line) { 
     $mask[$index] ||= $line[$index] =~ /\S/; 
    } 
} 

# At this point the mask indicates where to split based on the zeros within it. 
# Want to turn this into substr ranges. 
# So 000011110000 would become 4, 4 

my @substrings =(); # will contain [from, length] 
my $last_transition = 0; 
my $last_value = $mask[0]; 

# When it transitions from 0 to 1 or 1 to 0 the $last_transition is updated 
# When the last value was a 1 it means it has stopped being a section and needs 
# to be made into a split. 
foreach my $index (1..$#mask) { 
    if ($mask[$index] != $last_value) { 
     if ($last_value) { 
      push @substrings, [$last_transition, ($index + 1 - $last_transition)]; 
     } 
     $last_transition = $index; 
     $last_value = $mask[$index]; 
    } 
} 
# Handle the end of the line, which is considered a transition to 0 
if ($last_value) { 
    push @substrings, [$last_transition, ($#mask + 1 - $last_transition)]; 
} 

# Just print them to show that it works, you would collect these instead. 
foreach my $line (@lines) { 
    foreach my $split (@substrings) { 
     my $element = substr $line, $split->[0], $split->[1]; 
     $element =~ s/(?:^\s+|\s+$)//; 
     print "$line -> $element\n"; 
    } 
} 

ВЫВОД:

Filesystem   1K-blocks  Used Available Use% Mounted on -> Filesystem 
Filesystem   1K-blocks  Used Available Use% Mounted on -> 1K-blocks 
Filesystem   1K-blocks  Used Available Use% Mounted on -> Used 
Filesystem   1K-blocks  Used Available Use% Mounted on -> Available 
Filesystem   1K-blocks  Used Available Use% Mounted on -> Use% 
Filesystem   1K-blocks  Used Available Use% Mounted on -> Mounted on 
/dev/sda3    56776092 5431448 48413988 11%/-> /dev/sda3 
/dev/sda3    56776092 5431448 48413988 11%/-> 56776092 
/dev/sda3    56776092 5431448 48413988 11%/-> 5431448 
/dev/sda3    56776092 5431448 48413988 11%/-> 48413988 
/dev/sda3    56776092 5431448 48413988 11%/-> 11% 
/dev/sda3    56776092 5431448 48413988 11%/->/
/dev/sda1    101086  18993  76874 20% /boot -> /dev/sda1 
/dev/sda1    101086  18993  76874 20% /boot -> 101086 
/dev/sda1    101086  18993  76874 20% /boot -> 18993 
/dev/sda1    101086  18993  76874 20% /boot -> 76874 
/dev/sda1    101086  18993  76874 20% /boot -> 20% 
/dev/sda1    101086  18993  76874 20% /boot -> /boot 
tmpfs     2021888   0 2021888 0% /dev/shm -> tmpfs 
tmpfs     2021888   0 2021888 0% /dev/shm -> 2021888 
tmpfs     2021888   0 2021888 0% /dev/shm -> 0 
tmpfs     2021888   0 2021888 0% /dev/shm -> 2021888 
tmpfs     2021888   0 2021888 0% /dev/shm -> 0% 
tmpfs     2021888   0 2021888 0% /dev/shm -> /dev/shm 

Очевидно, что вы бы обработать первую строку на элементы, а не печатать его.

Смежные вопросы