[25ae32e] | 1 | #!/usr/bin/perl |
---|
| 2 | |
---|
| 3 | use locale; |
---|
| 4 | |
---|
| 5 | my $input = <>; |
---|
| 6 | chomp $input; |
---|
| 7 | |
---|
| 8 | our $pos_re = qr/(?:[[:upper:]]+)/; |
---|
| 9 | our $attr_re = qr/(?:[[:upper:]]+)/; |
---|
| 10 | our $val_re = qr/(?:[[:lower:][:digit:]+?!*-]|<[^>\n]+>)/; |
---|
| 11 | our $av_re = qr/(?:$attr_re$val_re+)/; |
---|
| 12 | our $avlist_re = qr/(?:$av_re+)/; |
---|
| 13 | our $cat_re = qr/(?:$pos_re(?:\/$avlist_re)?)/; |
---|
| 14 | |
---|
| 15 | print pre($input); |
---|
| 16 | |
---|
| 17 | sub parse ($) |
---|
| 18 | { |
---|
| 19 | my ($dstr)=@_; |
---|
| 20 | my $avs={}; |
---|
| 21 | my ($cat,$attrlist) = split '/', $dstr; |
---|
| 22 | ATTR: |
---|
| 23 | while( $attrlist =~ /($attr_re)($val_re+)/g ) |
---|
| 24 | { |
---|
| 25 | my ($attrstr,$valstr)=($1,$2); |
---|
| 26 | my %vals; |
---|
| 27 | while($valstr =~ /$val_re/g) |
---|
| 28 | { |
---|
| 29 | my $val = $&; |
---|
| 30 | next ATTR if $val eq '*'; |
---|
| 31 | $val =~ s/^<([[:lower:]])>$/$1/; |
---|
| 32 | $vals{$val}=1; |
---|
| 33 | } |
---|
| 34 | |
---|
| 35 | $avs->{$attrstr} = \%vals; # dlaczego to dziala? %vals jest lokalne |
---|
| 36 | } |
---|
| 37 | [$cat, $avs]; |
---|
| 38 | } |
---|
| 39 | |
---|
| 40 | sub unparse (\@) |
---|
| 41 | { |
---|
| 42 | my ($cat,$avs)= @{shift @_}; |
---|
| 43 | my $dstr=$cat; |
---|
| 44 | my @attrs = keys %$avs; |
---|
| 45 | if(@attrs) |
---|
| 46 | { |
---|
| 47 | $dstr .= '/'; |
---|
| 48 | for my $attr ( sort @attrs ) |
---|
| 49 | { |
---|
| 50 | $dstr .= $attr . (join '', sort keys %{$avs->{$attr}}); |
---|
| 51 | } |
---|
| 52 | } |
---|
| 53 | $dstr; |
---|
| 54 | } |
---|
| 55 | |
---|
| 56 | sub canonize ($) |
---|
| 57 | { |
---|
| 58 | unparse @{parse shift} ; |
---|
| 59 | } |
---|
| 60 | |
---|
| 61 | sub pre |
---|
| 62 | { |
---|
| 63 | my $pos_res = '[[:upper:]]+'; |
---|
| 64 | my $attr_res = '[[:upper:]]+'; |
---|
| 65 | my $val_res = '[[:lower:][:digit:]+?!*-]|<[^>\n[:cntrl:]]+>'; |
---|
| 66 | my $av_res = "$attr_res($val_res)+"; |
---|
| 67 | my $avlist_res = "($av_res)+"; |
---|
| 68 | |
---|
| 69 | my $pat = canonize(shift); |
---|
| 70 | my $ret; |
---|
| 71 | my ($pos,$avlist) = split /\//, $pat; |
---|
| 72 | $ret = $pos.'(\/'; |
---|
| 73 | while ($avlist =~ /($attr_res)(${val_res}+)/g) |
---|
| 74 | { |
---|
| 75 | my $attr = $1; |
---|
| 76 | my $vals = $2; |
---|
| 77 | my $vals = "($val_res)*(".join('|',($vals =~ /$val_res/g)).")($val_res)*"; |
---|
| 78 | $ret .= "($av_res)*$attr$vals"; |
---|
| 79 | } |
---|
| 80 | $ret .= "($av_res)*)?"; |
---|
| 81 | return $ret; |
---|
| 82 | } |
---|
| 83 | |
---|