view release on metacpan or  search on metacpan

lib/Dpkg/BuildFlags.pm  view on Meta::CPAN

sub strip {
    my ($self, $flag, $value, $src, $maint) = @_;

    my %strip = map { $_ => 1 } split /\s+/, $value;

    $self->{flags}->{$flag} = join q{ }, grep {
        ! exists $strip{$_}
    } split q{ }, $self->{flags}{$flag};
    $self->{origin}->{$flag} = $src if defined $src;
    $self->{maintainer}->{$flag} = $maint if $maint;
}

=item $bf->append($flag, $value, $source, $maint)

Append the options listed in $value to the current value of the flag $flag.
Record its origin as $source (if defined). Record it as maintainer modified
if $maint is defined and true.

=cut

sub append {
    my ($self, $flag, $value, $src, $maint) = @_;
    if (length($self->{flags}->{$flag})) {
        $self->{flags}->{$flag} .= " $value";
    } else {
        $self->{flags}->{$flag} = $value;
    }
    $self->{origin}->{$flag} = $src if defined $src;
    $self->{maintainer}->{$flag} = $maint if $maint;
}

=item $bf->prepend($flag, $value, $source, $maint)

Prepend the options listed in $value to the current value of the flag $flag.
Record its origin as $source (if defined). Record it as maintainer modified
if $maint is defined and true.

=cut

sub prepend {
    my ($self, $flag, $value, $src, $maint) = @_;
    if (length($self->{flags}->{$flag})) {
        $self->{flags}->{$flag} = "$value " . $self->{flags}->{$flag};
    } else {
        $self->{flags}->{$flag} = $value;
    }
    $self->{origin}->{$flag} = $src if defined $src;
    $self->{maintainer}->{$flag} = $maint if $maint;
}


=item $bf->update_from_conffile($file, $source)

Update the current build flags based on the configuration directives
contained in $file. See L<dpkg-buildflags(1)> for the format of the directives.

$source is the origin recorded for any build flag set or modified.

=cut

sub update_from_conffile {
    my ($self, $file, $src) = @_;
    local $_;

    return unless -e $file;
    open(my $conf_fh, '<', $file) or syserr(g_('cannot read %s'), $file);
    while (<$conf_fh>) {
        chomp;
        # Skip comments.
        next if /^\s*#/;
        # Skip empty lines.
        next if /^\s*$/;
        if (/^(append|prepend|set|strip)\s+(\S+)\s+(\S.*\S)\s*$/i) {
            my ($op, $flag, $value) = ($1, $2, $3);
            unless (exists $self->{flags}->{$flag}) {
                warning(g_('line %d of %s mentions unknown flag %s'), $., $file, $flag);
                $self->{flags}->{$flag} = '';
            }
            if (lc($op) eq 'set') {
                $self->set($flag, $value, $src);
            } elsif (lc($op) eq 'strip') {
                $self->strip($flag, $value, $src);
            } elsif (lc($op) eq 'append') {
                $self->append($flag, $value, $src);
            } elsif (lc($op) eq 'prepend') {
                $self->prepend($flag, $value, $src);
            }
        } else {
            warning(g_('line %d of %s is invalid, it has been ignored'), $., $file);
        }
    }
    close($conf_fh);
}

=item $bf->get($flag)

Return the value associated to the flag. It might be undef if the
flag doesn't exist.

=cut

sub get {
    my ($self, $key) = @_;
    return $self->{flags}{$key};
}

=item $bf->get_feature_areas()

Return the feature areas (i.e. the area values has_features will return
true for).

=cut

sub get_feature_areas {
    my $self = shift;

    return keys %{$self->{features}};
}

=item $bf->get_features($area)