diff options
Diffstat (limited to 'SBO-Lib/lib/SBO/Lib/Info.pm')
-rw-r--r-- | SBO-Lib/lib/SBO/Lib/Info.pm | 52 |
1 files changed, 39 insertions, 13 deletions
diff --git a/SBO-Lib/lib/SBO/Lib/Info.pm b/SBO-Lib/lib/SBO/Lib/Info.pm index 3f20497..b79c7fd 100644 --- a/SBO-Lib/lib/SBO/Lib/Info.pm +++ b/SBO-Lib/lib/SBO/Lib/Info.pm @@ -4,7 +4,7 @@ use 5.016; use strict; use warnings; -our $VERSION = '2.1'; +our $VERSION = '2.5'; use SBO::Lib::Util qw/ get_arch get_sbo_from_loc open_read script_error slurp usage_error /; use SBO::Lib::Tree qw/ get_orig_location get_sbo_location is_local /; @@ -18,6 +18,7 @@ our @EXPORT_OK = qw{ get_orig_version get_requires get_sbo_version + parse_info }; our %EXPORT_TAGS = ( @@ -132,18 +133,13 @@ sub get_from_info { usage_error("get_from_info: could not read $args{LOCATION}/$sbo.info.") unless defined $contents; - $contents =~ s/("|\\\n)//g; - my $last_key = ''; + my %parse = parse_info($contents); + script_error("error when parsing $sbo.info file.") unless %parse; + $store = {}; $store->{LOCATION} = [$args{LOCATION}]; - foreach my $line (split /\n/, $contents) { - my ($key, $val) = $last_key; - if ($line =~ /^([^=\s]+)=(.*)$/) { $key = $1; $val = $2; } - elsif ($line =~ /^\s+([^\s].+)$/) { $val = $1; } - else { script_error("error when parsing $sbo.info file. Line: $line") } - push @{ $store->{$key} }, ($val ? split(' ', $val) : $val); - $last_key = $key; - } + foreach my $k (keys %parse) { $store->{$k} = $parse{$k}; } + # allow local overrides to get away with not having quite all the fields if (is_local($sbo)) { for my $key (qw/DOWNLOAD_x86_64 MD5SUM_x86_64 REQUIRES/) { @@ -184,7 +180,7 @@ C<get_requires()> returns the requirements for a given C<$sbo>. # wrapper to pull the list of requirements for a given sbo sub get_requires { my $location = get_sbo_location(shift); - return() unless $location; + return [] unless $location; my $info = get_from_info(LOCATION => $location, GET => 'REQUIRES'); return $info; } @@ -205,6 +201,36 @@ sub get_sbo_version { return $version->[0]; } +=head2 parse_info + + my %parse = parse_info($str); + +C<parse_info()> parses the contents of an .info file from C<$str> and returns +a key-value list of it. + +=cut + +sub parse_info { + script_error('parse_info requires an argument.') unless @_ == 1; + my $info_str = shift; + my $pos = 0; + my %ret; + + while ($info_str =~ /\G([A-Za-z0-9_]+)="([^"]*)"\s*(?:\n|\z)/g) { + my ($key, $val) = ($1, $2); + $val =~ s/\\[ \t]*$/ /mg; + my @val = split " ", $val; + @val = '' unless @val; + $ret{$key} = \@val; + $pos = pos($info_str); + } + + return if $pos != length($info_str); + + return %ret; + +} + =head1 AUTHORS SBO::Lib was originally written by Jacob Pipkin <j@dawnrazor.net> with @@ -215,7 +241,7 @@ Guldstrand <andreas.guldstrand@gmail.com>. The sbotools are licensed under the WTFPL <http://sam.zoy.org/wtfpl/COPYING>. -Copyright (C) 2012-2016, Jacob Pipkin, Luke Williams, Andreas Guldstrand. +Copyright (C) 2012-2017, Jacob Pipkin, Luke Williams, Andreas Guldstrand. =cut |