view release on metacpan or  search on metacpan

lib/BBCode/Util.pm  view on Meta::CPAN

sub parseInt($) {
	my $num = shift;
	return undef if not defined $num;
	$num =~ s/[\s,_]+//g;
	$num =~ s/^\+//;
	return 0	if $num =~ /^-?$/;
	return 0+$1	if $num =~ /^ ( -? \d+ ) $/x;
	return undef;
}

BEGIN { _export qw(parseNum parse) }
sub parseNum($);
sub parseNum($) {
	my $num = shift;
	return undef if not defined $num;
	$num =~ s/[\s,_]+//g;
	if($num =~ /^ (.*) e (.*) $/ix) {
		my($m,$e) = ($1,$2);
		$m = parseNum $m;
		$e = parseNum $e;
 		return $m * (10 ** $e) if defined $m and defined $e;
		return undef;
 	}
	if($num =~ /^ ([^.]*) \. ([^.]*) $/x) {
		my($i,$f) = ($1,$2);
		$i = parseInt $i;
		return undef unless defined $i;
		return undef unless $f =~ /^(\d*)$/;
		$num = "$i.$f";
		$num =~ s/\.$//;
		return 0+$num;
	}
	return parseInt($num);
}

BEGIN { _export qw(parseEntity parse) }
sub parseEntity($);
sub parseEntity($) {
	local $_ = $_[0];
	return undef unless defined $_;
	s/^&(.*);$/$1/;
	s/^#([xob])/0$1/i;
	s/^#//;
	s/^U\+/0x/;

	my $ch;
	if(/^ 0x ([0-9A-F]+) $/xi) {
		$ch = hex($1);
	} elsif(/^ 0o ([0-7]+) $/xi) {
		$ch = oct($1);
	} elsif(/^ 0b ([01]+) $/xi) {
		my $b = ("\0" x 4) . pack("B*", $1);
		$ch = unpack "N", substr($b, -4);
	} elsif(/^ 0 ([0-7]{3}) $/x) {
		$ch = oct($1);
	} elsif(/^ (\d+) $/x) {
		$ch = 0+$1;
	}
	return sprintf "#x%X", $ch if defined $ch;

	my $decoded = HTML::Entities::decode("&$_;");
	return undef if $decoded eq "&$_;";
	return $_;
}

BEGIN { _export qw(parseListType parse) }
my %listtype = (
	'*'		=> [ qw(ul) ],
	'1'		=> [ qw(ol decimal) ],
	'01'	=> [ qw(ol decimal-leading-zero) ],
	'A'		=> [ qw(ol upper-latin) ],
	'a'		=> [ qw(ol lower-latin) ],
	'I'		=> [ qw(ol upper-roman) ],
	'i'		=> [ qw(ol lower-roman) ],
	"\x{3B1}"	=> [ qw(ol lower-greek) ],
	"\x{5D0}"	=> [ qw(ol hebrew) ],
	"\x{3042}"	=> [ qw(ol hiragana) ],
	"\x{3044}"	=> [ qw(ol hiragana-iroha) ],
	"\x{30A2}"	=> [ qw(ol katakana) ],
	"\x{30A4}"	=> [ qw(ol katakana-iroha) ],
);
sub parseListType($) {
	local $_ = $_[0];
	my @ret;
	if(defined $_) {
		if(/^(disc|circle|square|none)$/i) {
			@ret = ('ul', lc $1);
		} elsif(/^(
			decimal(?:-leading-zero)? |
			(?:upper|lower)-(?:roman|latin|alpha) |
			lower-greek |
			hebrew |
			georgian |
			armenian |
			cjk-ideographic |
			(?:hiragana|katakana)(?:-iroha)?
		)$/ix) {
			@ret = ('ol', lc $1);
		} elsif(exists $listtype{$_}) {
			@ret = @{$listtype{$_}};
		}
	}
	return @ret;
}

# Conversion factors from CSS units to points
my %conv = (
	# Integer conversions within English units
	pt	=> 1,
	pc	=> 12,
	in	=> 72,

	# Floating-point conversions from Metric units
	mm	=> 72/25.4,
	cm	=> 72/2.54,

	# Somewhat approximate, but the CSS standard is actually rather
	# picky about how many pixels a 'pixel' is at different resolutions,
	# so this is actually relatively reliable.
	px	=> 0.75,
);