view release on metacpan or  search on metacpan

lib/CSS/DOM/PropertyParser.pm  view on Meta::CPAN

     unless $7 eq '|';
    push @group_start, length $pattern;
    push @permut_marker, [];
    $7 eq '(' and push @capture_nums, ++$last_capture;
   }
  }
  else {
   $pattern .= do{$7 =~ /^[?*+]\z/}   ? $7
             : do{$7 =~ /^[;{},:]\z/} ? quotemeta $7
             :  '(?:d(?(?{$$tokens[-1+pos]eq"' .quotemeta($7) .'"})|(?!)))'
             ;
  }
 }

 # There may be top-level ‘||’ things, so we check for those.
 if(@{$permut_marker[0]}) {
    unshift @{ $permut_marker[0] }, $group_start[0];
    _make_permutations($pattern, $permut_marker[0]);
 }

 # Deal with the match vars
 $pattern .= ')(?{@Match=@{$match[-1]};@List=@{$list[-1]};%Match=%match})'
  unless $no_match_stuff;

 use re 'eval';
 return qr/$pattern/;
}

sub _make_permutations { # args: pattern, \@markers
                         # pattern is modified in-place
 my $markers = pop;
 for my $pattern($_[0]) {
    # Split up the end of the pattern back to the beginning of the inner-
    # most enclosing group, as specified by the markers. Put the separate
    # pieces into @alts.
    my @alts;
    for(reverse @$markers) {
     unshift @alts, substr $pattern, $_, length $pattern, '';
    }
    
    # Do the permutations
    $pattern .= _permute(@alts);
 }
}

sub _permute {
 if(@_ == 2) { return "(?:$_[0]$_[1]?|$_[1]$_[0]?)" }
 else {
  return
     "(?:"
   . join("|", map $_[$_] . _permute(@_[0..$_-1,$_+1...$#_]) . '?', 0..$#_)
   . ")"
 }
}


=begin comment

Colour names:

perl -MRegexp::Assemble -le 'my $ra = new Regexp::Assemble; $ra->add($_) for qw " transparent aliceblue antiquewhite aqua aquamarine azure beige bisque black blanchedalmond blue blueviolet brown burlywood cadetblue chartreuse chocolate coral cornflow...

perl -MRegexp::Assemble -le 'my $ra = new Regexp::Assemble; $ra->add($_) for qw " activeborder activecaption appworkspace background buttonface buttonhighlight buttonshadow buttontext captiontext graytext highlight highlighttext inactiveborder inacti...

=end comment

=cut

$colour_names_re = '(?:d(?:ark(?:s(?:late(?:gr[ae]y|blue)|(?:eagree|almo)n)|g(?:r(?:e(?:en|y)|ay)|oldenrod)|o(?:r(?:ange|chid)|livegreen)|(?:turquois|blu)e|magenta|violet|khaki|cyan|red)|eep(?:skyblue|pink)|imgr[ae]y|odgerblue)|l(?:i(?:ght(?:s(?:(?:e...

$system_colour_names_re = '(?:in(?:active(?:caption|border)|fo(?:background|text)|cativecaptiontext)|b(?:utton(?:(?:highligh|tex)t|shadow|face)|ackground)|threed(?:(?:light|dark)?shadow|highlight|face)|(?:(?:caption|gray)tex|highligh(?:ttex)?)t|a(?:c...

=encoding utf8

=head1 NAME

CSS::DOM::PropertyParser - Parser for CSS property values

=head1 VERSION

Version 0.17

=head1 SYNOPSIS

  use CSS::DOM::PropertyParser;
  
  $spec = new CSS::DOM::PropertyParser; # empty
  # OR
  $spec = $CSS::DOM::PropertyParser::Default->clone;
  
  $spec->add_property(
   overflow => {
    format => 'visible|hidden|scroll|auto',
    default => 'visible',
    inherit => 0,
   }
  );
  
  $hashref = $spec->get_property('overflow');
  
  $hashref = $spec->delete_property('overflow');
  
  @names = $spec->property_names;

=head1 DESCRIPTION

Objects of this class provide lists of supported properties for L<CSS::DOM>
style sheets. They also describe the syntax and parsing of those 
properties' values.

Some CSS properties simply have their own values (e.g., overflow); some
are abbreviated forms of several other properties (e.g., font). These are
referred to in this documentation as 'simple' and 'shorthand' properties.

=head1 CONSTRUCTOR

C<$spec = new CSS::DOM::PropertyParser> returns an object that does not
recognise any properties, to which you
can add your own properties.

There are two parser objects that come with this module. These are

lib/CSS/DOM/PropertyParser.pm  view on Meta::CPAN

This feature only applies to single identifiers. In fact, it exists solely
for the font property's use.

=item list

Set to true if the property is a list of values. The capturing parentheses
in the format determine the individual values of the list.

This applies to simple properties only.

=item properties

For a shorthand property, list the sub-properties here. The keys are the
property names. The values are array refs. The elements within the arrays
are numbers indicating which captures in the format are to be used for the
sub-property's value. They are tried one after the other. Whichever is the
first that matches (null matches not counting) is used.

Sub-properties that are referenced in the C<format> need not be listed 
here.

=item serialise

For shorthand properties only. Set this to a subroutine that serialises the
property. It is called with a hashref of sub-properties as its sole 
argument. The values of the hash are blank for properties that are set to
their initial values. This sub is only called when all sub-properties are
set.

=back

=head2 Example

=cut

0&&q r

=for ;

  our $CSS21 = new CSS::DOM::PropertyParser;
  my %properties = (
    azimuth => {
     format => '<angle> |
                 [ left-side | far-left | left | center-left |
                   center | center-right | right | far-right |
                   right-inside ] || behind
                | leftwards | rightwards',
     default => '0',
     inherit => 1,
    },

   'background-attachment' => {
     format  => 'scroll | fixed',
     default => 'scroll',
     inherit => 0,
    },

   'background-color' => {
     format  => '<colour>',
     default => 'transparent',
     inherit => 0,
    },

   'background-image' => {
     format => '<url> | none',
     default => 'none',
     inherit => 0,
    },
    
   'background-position' => {
     format => '[<percentage>|<length>|left|right]
                 [<percentage>|<length>|top|center|bottom]? |
                [top|bottom] [left|center|right]? |
                center [<percentage>|<length>|left|right|top|bottom|
                        center]?',
     default => '0% 0%',
     inherit => 0,
    },
    
   'background-repeat' => {
     format => 'repeat | repeat-x | repeat-y | no-repeat',
     default => 'repeat',
     inherit => 0,
    },
    
    background => {
     format => "'background-color' || 'background-image' ||
                'background-repeat' || 'background-attachment' ||
                'background-position'",
     serialise => sub {
      my $p = shift;
      my $ret = '';
      for(qw/ background-color background-image background-repeat
              background-attachment background-position /) {
       length $p->{$_} and $ret .= "$p->{$_} ";
      }
      chop $ret;
      length $ret ? $ret : 'none'
     },
    },
    
   'border-collapse' => {
     format => 'collapse | separate',
     inherit => 1,
     default => 'separate',
    },
    
   'border-color' => {
     format => '(<colour>)[(<colour>)[(<colour>)(<colour>)?]?]?',
     properties => {
      'border-top-color' => [1],
      'border-right-color' => [2,1],
      'border-bottom-color' => [3,1],
      'border-left-color' => [4,2,1],
     },
     serialise => sub {
       my $p = shift;
       my @vals = map $p->{"border-$_-color"},
                      qw/top right bottom left/;
       $vals[3] eq $vals[1] and pop @vals,