Browse Source

fix interpreter for conditions (OR was AND) make XML parser evaluate parameters (parameters and deps were ignored) keep order of goals passed on command line perl-bugoid workaround minor cleanups

Michael van Elst 23 years ago
parent
commit
30d3a92f50
1 changed files with 30 additions and 20 deletions
  1. 30 20
      openpkg-tool/openpkg-build.pl

+ 30 - 20
openpkg-tool/openpkg-build.pl

@@ -122,13 +122,13 @@ sub conditional ($$) {
             die "FATAL: stack underflow in: $cond\n" if scalar(@s)<2;
             die "FATAL: stack underflow in: $cond\n" if scalar(@s)<2;
             my($a) = pop @s;
             my($a) = pop @s;
             my($b) = pop @s;
             my($b) = pop @s;
-            push @s, $a && $b;
+            push @s, $a || $b;
         } elsif ($_ eq '!') {
         } elsif ($_ eq '!') {
             die "FATAL: stack underflow in: $cond\n" if scalar(@s)<1;
             die "FATAL: stack underflow in: $cond\n" if scalar(@s)<1;
             my($a) = pop @s;
             my($a) = pop @s;
             push @s, !$a;
             push @s, !$a;
         } else {
         } else {
-            push @s, $with->{$_} eq 'yes';
+            push @s, ($with->{$_} eq 'yes') ? 1 : 0;
         }
         }
     }
     }
     die "FATAL: stack underflow in: $cond\n" if scalar(@s)<1;
     die "FATAL: stack underflow in: $cond\n" if scalar(@s)<1;
@@ -138,6 +138,21 @@ sub conditional ($$) {
     return $res;
     return $res;
 }
 }
 
 
+sub with_list ($$) {
+    my($bags,$with) = @_;
+    my($bag,$li);
+    my(@out);
+
+    foreach $bag (@$bags) {
+        next unless conditional($bag->{'cond'}, $with);
+        foreach $li (@{$bag->{'rdf:bag'}}) {
+            push @out, @{$li->{'rdf:li'}};
+        }
+    }
+
+    return \@out;
+}
+
 ##########################################################################
 ##########################################################################
 
 
 my($RPM,$RPM_PRIV,$RPM_NPRIV,$CURL,$PROG);
 my($RPM,$RPM_PRIV,$RPM_NPRIV,$CURL,$PROG);
@@ -341,15 +356,16 @@ sub get_revdep ($) {
 sub parse_options ($) {
 sub parse_options ($) {
     my($l) = @_;
     my($l) = @_;
     $l = join("\n",@$l) if ref $l;
     $l = join("\n",@$l) if ref $l;
-    return unless $l =~ s/.*Options://;
+    return unless $l =~ s/.*Options//;
     my(%with) = $l =~ /--define\s*'(\S+)\s+(\S+?)'/g;
     my(%with) = $l =~ /--define\s*'(\S+)\s+(\S+?)'/g;
     return \%with;
     return \%with;
 }
 }
 
 
 sub override_options ($$$) {
 sub override_options ($$$) {
     my($old, $new, $reg) = @_;
     my($old, $new, $reg) = @_;
-    while (my ($k,$v) = each %$new) {
-        $old->{$k} = $v if exists $old->{$k} || $k =~ /^$reg$/;
+
+    foreach my $k (keys %$new) {
+        $old->{$k} = $new->{$k} if exists $old->{$k} || $k =~ /^$reg$/;
     }
     }
 }
 }
 
 
@@ -617,15 +633,9 @@ sub get_index ($$$) {
                 release  => $release,
                 release  => $release,
                 platform => xel($_->{'Platform'}),
                 platform => xel($_->{'Platform'}),
                 prefix   => xel($_->{'Prefixes'}),
                 prefix   => xel($_->{'Prefixes'}),
-                depends  =>
-                    ( $_->{'BuildPreReq'}->[0]->{'rdf:bag'}->[0]->{'rdf:li'}
-                    || [] ),
-                keeps    =>
-                    ( $_->{'PreReq'}->[0]->{'rdf:bag'}->[0]->{'rdf:li'}
-                    || [] ),
-                conflicts =>
-                    ( $_->{'Conflicts'}->[0]->{'rdf:bag'}->[0]->{'rdf:li'}
-                    || [] ),
+                depends  => with_list($_->{'BuildPreReq'}, $with),
+                keeps    => with_list($_->{'PreReq'}, $with),
+                conflicts => with_list($_->{'Conflicts'}, $with),
                 desc     => xel($_->{'Description'})
                 desc     => xel($_->{'Description'})
             };
             };
             $rec->{OPTIONS} = parse_options($rec->{desc});
             $rec->{OPTIONS} = parse_options($rec->{desc});
@@ -1017,7 +1027,7 @@ sub make_dep ($$$$$$) {
                 }
                 }
                 push @deps, $t;
                 push @deps, $t;
             } else {
             } else {
-                print "# $target->{name} searches for a frood called '$_'\n";
+                print "# $target->{name} searches a frood called '$_'\n";
                 push(@{$env->{fatal}},vsn($target));
                 push(@{$env->{fatal}},vsn($target));
                 target_setstatus($target,'UNDEF',4);
                 target_setstatus($target,'UNDEF',4);
                 push @$clist, $target;
                 push @$clist, $target;
@@ -1086,8 +1096,10 @@ sub build_list ($$) {
                 push @todo, '^'.quotemeta($_).'$';
                 push @todo, '^'.quotemeta($_).'$';
             }
             }
         }
         }
-        $pattern = join('|',@todo);
-        @todo = grep(/$pattern/, keys %{$env->{repository}});
+        @todo = map {
+            my($p) = $_;
+            grep(/$p/, keys %{$env->{repository}})
+        } @todo;
     } else {
     } else {
         @todo = grep {
         @todo = grep {
                     my($n) = $_;
                     my($n) = $_;
@@ -1096,7 +1108,6 @@ sub build_list ($$) {
                 } keys %{$env->{repository}};
                 } keys %{$env->{repository}};
     }
     }
 
 
-
     #
     #
     # chose sources for goals from repository
     # chose sources for goals from repository
     #
     #
@@ -1429,8 +1440,7 @@ if ($opt_S) {
 } else {
 } else {
     if (@{$env->{fatal}}) {
     if (@{$env->{fatal}}) {
         die "FATAL errors occured while building:\n",
         die "FATAL errors occured while building:\n",
-            join ',',
-                @{$env->{fatal}},
+            join (',', @{$env->{fatal}}),
             "\n";
             "\n";
     }
     }