… | |
… | |
555 | no warnings 'utf8'; |
555 | no warnings 'utf8'; |
556 | |
556 | |
557 | sub parse_resource { |
557 | sub parse_resource { |
558 | my ($term, $name, $isarg, $longopt, $flag, $value) = @_; |
558 | my ($term, $name, $isarg, $longopt, $flag, $value) = @_; |
559 | |
559 | |
560 | $name =~ y/-/./ if $isarg; |
|
|
561 | |
|
|
562 | $term->scan_extensions; |
560 | $term->scan_extensions; |
563 | |
561 | |
564 | my $r = $term->{meta}{resource}; |
562 | my $r = $term->{meta}{resource}; |
565 | keys %$r; # reset iterator |
563 | keys %$r; # reset iterator |
566 | while (my ($pattern, $v) = each %$r) { |
564 | while (my ($k, $v) = each %$r) { |
567 | if ( |
565 | my $pattern = $k; |
|
|
566 | $pattern =~ y/./-/ if $isarg; |
|
|
567 | my $prefix = $name; |
|
|
568 | my $suffix; |
568 | $pattern =~ /\.$/ |
569 | if ($pattern =~ /\-$/) { |
569 | ? $pattern eq substr $name, 0, length $pattern |
570 | $prefix = substr $name, 0, length $pattern; |
570 | : $pattern eq $name |
571 | $suffix = substr $name, length $pattern; |
571 | ) { |
572 | } |
|
|
573 | if ($pattern eq $prefix) { |
572 | $name = "$urxvt::RESCLASS.$name"; |
574 | $name = "$urxvt::RESCLASS.$k$suffix"; |
573 | |
575 | |
574 | push @{ $term->{perl_ext_3} }, $v->[0]; |
576 | push @{ $term->{perl_ext_3} }, $v->[0]; |
575 | |
577 | |
576 | if ($v->[1] eq "boolean") { |
578 | if ($v->[1] eq "boolean") { |
577 | $term->put_option_db ($name, $flag ? "true" : "false"); |
579 | $term->put_option_db ($name, $flag ? "true" : "false"); |