perlでCSSを生成するモジュールの作りかけ

perlでCSSを生成するモジュールの作りかけ

[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";

License

[4] >>1perlと同じライセンス

メモ

[2] 作者はもうメンテナンスする意思が無いそうです。 ライセンスは perlと同じライセンス

[3] というかこんなの使いまわすより1から書いたほうが早そうだけど。 (名無しさん [sage])