[1] Message::Markup::XML 風に CSS を生成できたらいいなーと思って試作してみた途中です。 最後のほうが使用例兼実験例になってます。
package foo::CSS;
use strict;
use overload '""' => sub {shift->stringify};
my %Type = (
'#attribute' => {
has_label => 1,
separator => ' ',
terminate_semicolon => 1,
},
'#block' => {
has_block => 1,
separator => "\n",
terminate_separator => 1,
use_indent => 1,
},
'#document' => {
separator => "\n",
},
'#rule' => {
has_block => 1,
has_label => 1,
separator => "\n",
terminate_separator => 1,
use_indent => 1,
},
'#statement' => {
is_at => 1,
separator => "\n",
terminate_semicolon => 1,
},
);
sub new ($;%) {
my $class = shift;
my $self = bless {@_}, $class;
$self->{node} = [];
$self;
}
sub _CLASS_TYPE ($) { 'foo::CSS' }
sub _get_nest_level ($) {
my $self = shift;
my $node = $self;
my $n = 0;
while (ref ($node->{parent}) eq $self->_CLASS_TYPE) {
$n++;
$node = $node->{parent};
}
$n;
}
sub _indent_wsp ($) {
my $self = shift;
$Type{$self->{type}}->{use_indent} ?
(' ' x ($self->_get_nest_level + 1)) : ;
}
sub inner_text ($) {
my $self = shift;
#if ($self->{type} eq '#block') {
my $r = ;#"{\n";
my $indent = $self->_indent_wsp;
$r .= $indent . $self->{value} . $Type{$self->{type}}->{separator} if length $self->{value};
for (@{$self->{node}}) {
if ($_->{type} ne '#selector') {
$r .= $indent;
$r .= $_ . $Type{$self->{type}}->{separator};
}
}
#$r .= "}";
$r =~ s/\Q$Type{$self->{type}}->{separator}\E$// unless $Type{$self->{type}}->{terminate_separator};
return $r;
#} else {
# return $self->{value};
#}
}
sub outer_text ($) {
my $self = shift;
if ($Type{$self->{type}}->{has_block}) {
my $r = ;
## Selector/@-rules
if ($Type{$self->{type}}->{has_label}) {
for (@{$self->{node}}) {
if ($_->{type} eq '#selector') {
$r .= $_;
last;
}
}
$r .= ' ';
}
## Block
$r .= "{\n" . $self->inner_text;
$r .= $self->{parent}->_indent_wsp if ref $self->{parent};
return $r . "}";
} else {
my $r = ;
## Attr/descriptor name
if ($Type{$self->{type}}->{has_label}) {
if ($self->{local_name}) {
$r .= $self->{local_name} . ': ';
}
## At statement
} elsif ($Type{$self->{type}}->{is_at}) {
$r .= '@' . $self->{local_name} . ' ';
}
## Value
$r .= $self->inner_text;
$r .= ';' if $Type{$self->{type}}->{terminate_semicolon};
return $r;
}
}
{no warnings;
*stringify = \&outer_text;}
sub append_new_node ($;%) {
my $self = shift;
my $new_node = __PACKAGE__->new (@_);
push @{$self->{node}}, $new_node;
$new_node->{parent} = $self;
$new_node;
}
sub append_new_value ($;%) {
my $self = shift;
my $new_node = foo::CSS::Value->new (@_);
push @{$self->{node}}, $new_node;
$new_node->{parent} = $self;
$new_node;
}
#sub set_attribute ($$$;%) {
# my ($self, $name, $value, %option) = @_;
# $option{name} = $name;
# $option{value} = $value unless ref $value;
# $option{type} = '#attribute';#
#
#}
package foo::CSS::Value;
our @ISA = qw/foo::CSS/;
use strict;
our %Type = (
'#comment' => {},
'#function' => {
is_function => 1,
},
'#keyword' => {},
'#string' => {},
);
sub outer_text ($) {
my $self = shift;
my $r = ;
if ($self->{type} eq '#string') {
$r = $self->value;
$r =~ s/([\\"])/\\$1/g; ## TODO: see spec!
$r = '"' . $r . '"';
} elsif ($self->{type} eq '#comment') {
$r = $self->value;
$r =~ s!\*/!*\\00002F!g;
$r = '/* ' . $r . ' */';
} elsif ($Type{$self->{type}}->{is_function}) {
$r = $self->{local_name} . '(' . $self->inner_text . ')';
} else {
$r = $self->inner_text;
}
$r;
}
sub inner_text ($) {
my $self = shift;
my $r = ;
if ($self->{type} eq '#string') {
$r = $self->value;
} else {
$r = $self->{value};
for (@{$self->{node}}) {
$r .= $_->outer_text;
}
}
$r;
}
sub value ($) {
my $self = shift;
my $r = ;
# if ($self->{type} eq '#string') {
$r = $self->{value};
for (@{$self->{node}}) {
$r .= $_->value;
}
# }
$r;
}
{no warnings;
*stringify = \&outer_text;
}
package main;
my $d = new foo::CSS (type=>'#document');
$d->append_new_node (type => '#statement', local_name => 'charset')
->append_new_value (type => '#string', value => 'us-ascii');
my $c = $d->append_new_node (type => '#rule');
$c->append_new_node (type => '#block')
->append_new_node (type => '#attribute', value => 'none');
$c->append_new_node (type => '#selector', value => 'e1 e2');
$c->append_new_node (type => '#attribute', local_name => 'border-style')
->append_new_value (type => '#keyword', value => 'solid');
$d->append_new_node (type => '#attribute', local_name => 'Invalid')
->append_new_value (type => '#string', value => 'invalid.');
$d->append_new_value (type => '#comment', value => '*COMMENT*');
my $v = $d->append_new_node (type => '#attribute', local_name => 'somewhat');
$v->append_new_value (type => '#function', local_name => 'url')
->append_new_value (type => '#string', value => 'http://foo.example/');
$v->append_new_value (type => '#string', value => 'fooBar');
$v->append_new_value (type => '#function', local_name => 'f');
print $d,"\n";[2] 作者はもうメンテナンスする意思が無いそうです。 ライセンスは perlと同じライセンス。