On Jun 26, 9:57 am, [EMAIL PROTECTED] (Pat Rice) wrote:
> Hi all
> I'm wondering if there is a nice way to parse this data, as in is
> there any module that could handle this type of data, as in the was it
> is presented? so that I can repeat is itn a tree like structure in
> HTML ?
>
> so I can pic out the tree like structure and replicate it in some way
> so that I can put it in an array or into a database ?? so i could pick
> out the data I want.
>
> \==+Interface :
> |----Link State.........................................Down
> \==+SCSI Interface :
> |----Name............................................vmhba1
> |----Console Name....................................scsi1
> |----Queue Depth.....................................4096
> \==+PCI Device :
> |----Bus..........................................0x0b
> |----Slot.........................................0x00
> |----Function.....................................0x00
> \==+Scsi Stats :
> |----Commands.....................................48632378
> |----Blocks Read..................................1862894689
> |----Blocks Written...............................858120919
> |----Aborts.......................................0
>
> Thanks in advance
> Pat
I had a similar situation and wrote some routines that I've used
for various purposes since.
If you can stand modifying your data to be a strictly indented
list, then you could use these: 'make_paths' parses the indented
list, and 'traverse_paths' iterates through the result.
#!/usr/local/bin/perl
use warnings;
use strict;
my $paths = do{ local $/; <DATA> }; # slurp
print "<ul>\n".traverse_paths( $paths, "\t" )."</ul>\n";
sub traverse_paths {
my( $paths, $tab ) = @_;
$paths = make_paths( $paths ) unless ref $paths;
$tab ||= '';
my @ret;
foreach my $path ( @$paths ) {
my $rest;
if( ref $path ) {
$rest = $path->[1]; # do first :-)
$path = $path->[0];
}
push @ret, "$tab<li>$path";
if( $rest ) {
push @ret,
"\n$tab<ul>\n" .
traverse_paths( $rest, "$tab\t" ) .
"$tab</ul></li>\n";
}
else {
push @ret, "</li>\n";
}
}
join "", @ret; # returned
}
sub make_paths {
my( $raw, $char, $num ) = @_;
return unless defined $raw;
$char = ' ' unless defined $char;
$num = 4 unless defined $num;
my @cooked;
my @a = split "\n", $raw;
for my $i ( 0 .. $#a ) {
my( $indent, $string ) = $a[ $i ] =~ /^($char*)(.*)/;
my $len = length( $indent );
my( $lookahead ) = $i == $#a ? '': $a[ $i+1 ] =~ /^($char*)/;
$lookahead = length( $lookahead ) > $len;
my $level = $len/$num;
my $dref = [EMAIL PROTECTED];
$dref = $dref->[-1][-1] for 1 .. $level;
push @$dref, $lookahead ? [$string,[]] : $string;
}
return [EMAIL PROTECTED];
}
__DATA__
Interface :
Link State.........................................Down
SCSI Interface :
Name............................................vmhba1
Console Name....................................scsi1
Queue Depth.....................................4096
PCI Device :
Bus..........................................0x0b
Slot.........................................0x00
Function.....................................0x00
Scsi Stats :
Commands.....................................48632378
Blocks Read..................................
1862894689
Blocks Written...............................858120919
Aborts.......................................0
__RESULT__
<ul>
<li>Interface :
<ul>
<li>Link
State.........................................Down</li>
<li>SCSI Interface :
<ul>
<li>Name............................................vmhba1</li>
<li>Console
Name....................................scsi1</li>
<li>Queue
Depth.....................................4096</li>
<li>PCI Device :
<ul>
<li>Bus..........................................0x0b</li>
<li>Slot.........................................0x00</li>
<li>Function.....................................0x00</li>
<li>Scsi Stats :
<ul>
<li>Commands.....................................48632378</li>
<li>Blocks
Read..................................1862894689</li>
<li>Blocks
Written...............................858120919</li>
<li>Aborts.......................................0</li>
</ul></li>
</ul></li>
</ul></li>
</ul></li>
</ul>
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
