source: nawszelkiwypadek/tools/gue_dic/attr.pm @ 6b3be72

help
Last change on this file since 6b3be72 was f1563c0, checked in by obrebski <obrebski@…>, 17 years ago

git-svn-id: svn://atos.wmid.amu.edu.pl/utt@3 e293616e-ec6a-49c2-aa92-f4a8b91c5d16

  • Property mode set to 100644
File size: 2.0 KB
Line 
1package attr;
2
3use locale;
4use strict;
5
6
7sub match(\@\@)
8{
9    my ($cat1,$avs1)= @{shift @_};
10    my ($cat2,$avs2)= @{shift @_};
11
12    if($cat1 ne $cat2)
13    {
14        return 0; 
15    }
16    else
17    {
18      ATTR:for my $attr (keys %$avs1)
19      {
20          if($avs2->{$attr})
21          {
22              for my $val (keys %{$avs1->{$attr}})
23              {
24                  next ATTR if $avs2->{$attr}->{$val};
25              }
26              return 0;
27              last ATTR;
28          }
29      }
30    }
31
32    return 1;
33}
34
35# funkcja parse
36# arg:     deskrypcja
37# warto¶æ: referencja do tablicy [<cat>, <avs>],
38#          gdzie <avs> jest referencja do hasza, zawierajacego pary
39#          atrybut=>hasz warto¶ci (pary warto¶æ=>1), czyli np.
40
41#         [
42#           'ADJ',
43#           {
44#             'KOLEDZY' => {
45#                            '<alojzy>' => 1,
46#                            '<karol>' => 1,
47#                            '<jan>' => 1
48#                          },
49#             'C' => {
50#                      'p' => 1,
51#                      'a' => 1,
52#                      'i' => 1
53#                    },
54#             'N' => {
55#                      'p' => 1
56#                    }
57#           }
58#         ];
59
60sub parse ($)
61{
62    my ($dstr)=@_;
63    my $avs={};
64    my ($cat,$attrlist) = split '/', $dstr;
65  attr:
66    while( $attrlist =~ /([[:upper:]]+)((?:[[:lower:]+?!*-]|<[^>\n]+>)+)/g )
67    {
68        my ($attrstr,$valstr)=($1,$2);
69        my %vals;
70        while($valstr =~ /[[:lower:]+?!*-]|<[^>\n]+>/g)
71        {
72            my $val = $&;
73            next attr if $val eq '*';
74            $val =~ s/^<([[:lower:]])>$/$1/;
75            $vals{$val}=1;
76        }
77       
78        $avs->{$attrstr} = \%vals; # dlaczego to dziala? %vals jest lokalne
79    }
80    [$cat, $avs];
81}
82
83# funkcja unparse
84# arg:     jak warto¶æ parse
85# warto¶æ: deskrypcja - napis
86
87sub unparse (\@)
88{
89    my ($cat,$avs)= @{shift @_};
90    my $dstr=$cat;
91    my @attrs = keys %$avs;
92    if(@attrs)
93    {
94        $dstr .= '/';
95        for my $attr ( sort @attrs )
96        {
97            $dstr .= $attr . (join '', sort keys %{$avs->{$attr}});
98        }
99    }
100    $dstr;
101}
102
103
104sub canonize ($)
105{
106    unparse @{parse @_[0]} ;
107}
108
109
1101;
Note: See TracBrowser for help on using the repository browser.