File Coverage

blib/lib/Syntax/Highlight/CSS.pm

Criterion	Covered	Total	%
statement	64	66	96.9
branch	14	18	77.7
condition			n/a
subroutine	9	9	100.0
pod	2	2	100.0
total	89	95	93.6

package Syntax::Highlight::CSS;

use warnings;
use strict;

our $VERSION = '0.0102';

# # #
# # #
# # #
#
#
#
#    WARNING!!!! The code presented below is NOT suitable for persons
#    with heart deseases and mental disorders,
#
#    LOOK AT IT AT YOUR OWN RISK!!!!
#
#
#
# # #
# # #
# # #

sub new {
    my $class = shift;
    my %args = @_;
    $args{ +lc } = delete $args{$_}
        for keys %args;

    my $self = bless {}, $class;

    $self->_pre( defined $args{pre} ? $args{pre} : 1 );
    $self->_line_numbers( defined $args{nnn} ? $args{nnn} : 0 );

    return $self;
}

sub parse {
    my ( $self, $input ) = @_;

    $input = ''
        unless defined $input;

    my $text = $self->_parse_css( $input );

    if ( $self->_line_numbers ) {
        $text = $self->_add_line_numbers( $text );
    }

    if ( $self->_pre ) {
        $text = '' . $text . '';
    }

    return $text;
}

sub _add_line_numbers {
    my ( $self, $text ) = @_;
    my $line = 0;
    $text =~ s|^|
        ''
        . sprintf('%3d', $line++)
        . ' '
    |gem;

    return $text;
}

sub _parse_css {
    my $self = shift;

    $_ = shift; # input CSS

    # yes YES, blah blah is really retarded.. but oh well
    my @quoted;
    s/("  .+?  (?
        push @quoted, $1;
        'HIGHLIGHT<>PARSER<>QUOTED<>' . $#quoted . '>'
    /gsex;

    my @comments;
    s{(/\* .+? \*/)}{
        push @comments, $1;
        'HIGHLIGHT<>PARSER<>COMMENT<>' . $#comments . '>'
    }gsex;

    my @rulesets;
    s/(?<={)([^{}]+)(?=})/
        push @rulesets, $1;
        'HIGHLIGHT<>PARSER<>RULESET<>' . $#rulesets . '>';
    /gex;

    # parse selectors
    s# (?:\A | (?<=[{};]) )
        (\s*)
        ( [^;{}]+? )
        (\s*)
      (?=[{;])#
      $1
      . $self->_parse_sel($2)
      . $3
    #gex;

    # properties/values;
    for my $ruleset ( @rulesets ) {
        $ruleset =~ s#(?: \A | (?<=[;]) )
            (\s*) ([a-zA-Z-]+) (\s*) : (\s*) (.+?) (\s*)
            (?=[;}]|\z)#$1$2$3:$4$5$6#gsx;
    }

    s#HIGHLIGHT<>PARSER<>RULESET<>(\d+)>#$rulesets[$1]#g;

    s#
        (HIGHLIGHT<>PARSER<>COMMENT<>\d+>)
        (\s*)#$1$2#xg;

    s{()((?:(?!).)+)}{
        my ($one, $two) = ($1, $2);
        $two =~ /(.+?)(\s*HIGHLIGHT<>PARSER<>COMMENT<>\d>\s*)(.+)/
        ? qq|$one$1$2$3|
        : "$one$two";
    }ges;

    s#HIGHLIGHT<>PARSER<>COMMENT<>(\d+)>#$comments[$1]#g;

    s#HIGHLIGHT<>PARSER<>QUOTED<>(\d+)>#$quoted[$1]#g;

    return $_;
}

sub _parse_sel {
    my $self = shift;
    $_ = shift; # selector

    unless ( s#
        ( \@(?:media|charset|import) )
        (\s+)
        ([^;{]+?)
        (\s*)
        \z#$1$2$3$4#gix
    ) {
        s{(:{1,2} \s*)(\S+)}{$1$2}gx;
        s#(\s*)(.+)(\s*)#$1$2$3#sg;
    }

    return $_;
}

sub _pre {
    my $self = shift;
    if ( @_ ) {
        $self->{PRE} = shift;
    }
    return $self->{PRE};
}

sub _line_numbers {
    my $self = shift;
    if ( @_ ) {
        $self->{LINE_NUMBERS} = shift;
    }
    return $self->{LINE_NUMBERS};
}

1;
__END__