# -*- cperl -*-
# -----------------------------------------------------------------------------
# $Id: CSS.pm,v 1.1 2004/10/12 10:26:43 admin Exp $
# -----------------------------------------------------------------------------
package LinkExtractor::CSS;
use strict;
use warnings;

sub extract {
    # 戻り値: [[offset, tagname, link], [offset, tagname, link], ...]
    my $css_source = shift;
    my @result;

    # FIXME: url()を探すだけで、眞面目にパースしてゐない手抜き。
    # パースだけならCSS::SACで出來るが、ここではオフセットが知りたいので
    # LLgすら使へない。(Lexer/Parserを両方共自分で書くしか無い)
    my $re_nonascii   = qr{[\x80-\xff]};
    my $re_wc         = qr{[\x09\x0a\x0c\x0d\x20]};
    my $re_w          = qr{$re_wc*};
    my $re_unicode    = qr{\\[0-9a-fA-F]{1,6}$re_wc?};
    my $re_escape     = qr{$re_unicode|\\[\x20-\xff]};
    my $re_urlchar    = qr{[\x09\x21\x23-\x26\x27-\x7e]|$re_nonascii|$re_escape};
    my $re_nl         = qr{\x0a|\x0d\x0a|\x0d|\x0c};
    my $re_stringchar = qr{$re_urlchar|\x20|\\$re_nl};
    my $re_string     = qr{"(?:$re_stringchar|')*"|'(?:$re_stringchar|")*'};
    my $re_url        = qr{(url\($re_w)($re_string|$re_urlchar*)$re_w\)};
    my $re_comment    = qr{/\*[^*]*\*+([^/][^*]*\*+)*/};

    # コメントを削除
    $css_source =~ s/($re_comment)/';' x length $1/seg;
    
    # @namespace文を削除
    $css_source =~ s/^(\@namespace.+)$/' ' x length $1/meg;
    
    # @import "foo.css"; 形式を取り出す
    while ($css_source =~ s/(.*?(?:^|$re_nl))((\@import\s+)($re_string)\s*;)/$1 . (' ' x length $2)/se) {
	my $url = extract_raw_string($4);
	length $url and
	  push @result, [
	      length($1) + length($3) + 1, # $4は必ず"か'で始まる
	      'import',
	      $url,
	     ];
    }

    # @import url("foo.css"); 形式を取り出す
    while ($css_source =~ s/(.*?(?:^|$re_nl))((\@import\s+)$re_url\s*;)/$1 . (' ' x length $2)/se) {
	my $url = extract_raw_string($5);
	length $url and
	  push @result, [
	      length($1) + length($3) + length($4) + ($5 =~ m/^["']/ ? 1 : 0),
	      'import',
	      $url,
	     ];
    }

    # それ以外のurl("foo.png");を取り出す
    while ($css_source =~ s/(.*?)($re_url)/$1 . (' ' x length $2)/se) {
	my $url = extract_raw_string($4);
	length $url and
	  push @result, [
	      length($1) + length($3) + ($4 =~ m/^["']/ ? 1 : 0),
	      'value',
	      $url,
	     ];
    }

    \@result;
}

sub extract_raw_string {
    if ($_[0] =~ m/^(["'])(.*?)\1$/) {
	$2;
    }
    else {
	$_[0];
    }
}

1;
