Root/
| 1 | #!/usr/bin/perl |
| 2 | |
| 3 | |
| 4 | # |
| 5 | # determine the equivalent parts, taking into account that %eq is transitive |
| 6 | # |
| 7 | |
| 8 | sub eq |
| 9 | { |
| 10 | my %seen; |
| 11 | my @p = @_; # parts to consider |
| 12 | my @r = (); # new equivalences we've found |
| 13 | my $skip = @p; |
| 14 | |
| 15 | while (@p) { |
| 16 | my $p = shift @p; |
| 17 | next if $seen{$p}; |
| 18 | $seen{$p} = 1; |
| 19 | push(@r, $p) if $skip-- <= 0; |
| 20 | push(@p, @{ $eq{$p} }); |
| 21 | } |
| 22 | return @r; |
| 23 | } |
| 24 | |
| 25 | |
| 26 | # |
| 27 | # When looking for a description, we also consider equivalent parts. |
| 28 | # |
| 29 | # Furthermore, some descriptions may just be pointers to other descriptions. |
| 30 | # Users can add regular expressions that are used to extract references from |
| 31 | # a description, which are then looked up as well. |
| 32 | # |
| 33 | |
| 34 | sub __dsc_lookup |
| 35 | { |
| 36 | local ($id) = @_; |
| 37 | |
| 38 | for ($id, &eq($id)) { |
| 39 | return $dsc{$_} if defined $dsc{$_}; |
| 40 | } |
| 41 | return undef; |
| 42 | } |
| 43 | |
| 44 | |
| 45 | sub dsc_find |
| 46 | { |
| 47 | my $id = $_[0]; |
| 48 | LOOKUP: while (1) { |
| 49 | my $dsc = &__dsc_lookup($id); |
| 50 | return undef unless defined $dsc; |
| 51 | for (my $i = 0; $i <= $#xlat_from; $i++) { |
| 52 | # @@@ this is UUUUHHHGLLEEEEE !!! Why can't I just expand $to[$i] ? |
| 53 | next |
| 54 | unless ($id = $dsc) =~ s/^.*$xlat_from[$i].*$/$xlat_to[$i] $1/; |
| 55 | next LOOKUP if defined &__dsc_lookup($id); |
| 56 | } |
| 57 | return $dsc; |
| 58 | } |
| 59 | return undef; |
| 60 | } |
| 61 | |
| 62 | |
| 63 | sub dsc_xlat |
| 64 | { |
| 65 | local ($from, $to) = @_; |
| 66 | push(@xlat_from, $from); |
| 67 | push(@xlat_to, $to); |
| 68 | } |
| 69 | |
| 70 | |
| 71 | sub dsc_xlat_arg |
| 72 | { |
| 73 | return undef unless $_[0] =~ /^(.)([^\1]*)\1([^\1]*)\1$/; |
| 74 | &dsc_xlat($2, $3); |
| 75 | return 1; |
| 76 | } |
| 77 | |
| 78 | |
| 79 | # |
| 80 | # Lexical ordering of component references |
| 81 | # |
| 82 | |
| 83 | sub cmp_cref |
| 84 | { |
| 85 | local ($a, $b) = @_; |
| 86 | local ($as, $an, $bs, $bn); |
| 87 | |
| 88 | return $a cmp $b unless ($as, $an) = $a =~ /^([[:alpha:]]+)(\d*)$/; |
| 89 | return $a cmp $b unless ($bs, $bn) = $b =~ /^([[:alpha:]]+)(\d*)$/; |
| 90 | return $as cmp $bs unless $as eq $bs; |
| 91 | return $an <=> $bn |
| 92 | } |
| 93 | |
| 94 | |
| 95 | return 1; |
| 96 |
Branches:
master
