'; next }
elsif (lc$_ eq '[quote]') {
push @open, 'quote';
$result .= '' if !$maxlength;
$rmnewline = 1;
next
} elsif (lc$_ eq '[/spoiler]') {
if($open[$#open] eq 'spoiler') {
$result .= '';
pop @open;
}
next;
} elsif (lc$_ eq '[/quote]') {
if($open[$#open] eq 'quote') {
$result .= '
' if !$maxlength;
$rmnewline = 1;
pop @open;
}
next;
} elsif(lc$_ eq '[/url]') {
if($open[$#open] eq 'url') {
$result .= '';
pop @open;
}
next;
} elsif(s{\[url=((https?://|/)[^\]>]+)\]}{}i) {
$result .= $_;
push @open, 'url';
next;
} elsif(!grep(/url/, @open) &&
s{(.*)(http|https)://(.+[\d\w=/-])(.*)}
{$e->($1).qq|'.$e->('link').''.$e->($4)}e) {
$length += 4;
last if $maxlength && $length > $maxlength;
$result .= $_;
next;
} elsif(!grep(/url/, @open) && (
s{^(.*[^\w]|)([tdvpr][1-9][0-9]*)\.([1-9][0-9]*)([^\w].*|)$}{$e->($1).qq|$2.$3|.$e->($4)}e ||
s{^(.*[^\w]|)([tdvprug][1-9][0-9]*)([^\w].*|)$}{$e->($1).qq|$2|.$e->($3)}e)) {
$length += length $lit;
last if $maxlength && $length > $maxlength;
$result .= $_;
next;
}
} elsif(lc$_ eq '[/raw]') {
pop @open if $open[$#open] eq 'raw';
next;
}
# normal text processing
$length += length $_;
last if $maxlength && $length > $maxlength;
$result .= $e->($_);
}
$result .= $_ eq 'url' ? '' : $_ eq 'quote' ? '' : ''
while((local $_ = pop @open) ne 'first');
$result .= '...' if $maxlength && $length > $maxlength;
return $result;
}
# GTIN code as argument,
# Returns 'JAN', 'EAN', 'UPC' or undef,
# Also 'normalizes' the first argument in place
sub gtintype {
$_[0] =~ s/[^\d]+//g;
$_[0] =~ s/^0+//;
my $c = shift;
return undef if $c !~ /^[0-9]{12,13}$/; # only gtin-12 and 13
$c = ('0'x(13-length $c)) . $c; # pad with zeros
# calculate check digit according to
# http://www.gs1.org/productssolutions/barcodes/support/check_digit_calculator.html#how
my @n = reverse split //, $c;
my $n = shift @n;
$n += $n[$_] * ($_ % 2 != 0 ? 1 : 3) for (0..$#n);
return undef if $n % 10 != 0;
# Do some rough guesses based on:
# http://www.gs1.org/productssolutions/barcodes/support/prefix_list.html
# and http://en.wikipedia.org/wiki/List_of_GS1_country_codes
local $_ = $c;
return 'JAN' if /^4[59]/; # prefix code 450-459 & 490-499
return 'UPC' if /^(?:0[01]|0[6-9]|13|75[45])/; # prefix code 000-019 & 060-139 & 754-755
return undef if /(?:0[2-5]|2|97[789]|9[6-9])/; # some codes we don't want: 020–059 & 200-299 & 977-999
return 'EAN'; # let's just call everything else EAN :)
}
# Argument: hashref with rstat and vstat
# Returns: empty string if not in list, otherwise colour-encoded list status
sub liststat {
my $l = shift;
return '' if !$l;
my $rs = $YAWF::OBJ->{vn_rstat}[$l->{rstat}];
$rs = qq|