File Coverage

blib/lib/Text/Tags/Parser.pm

Criterion	Covered	Total	%
statement	51	51	100.0
branch	21	22	95.4
condition	20	27	74.0
subroutine	7	7	100.0
pod	4	4	100.0
total	103	111	92.7

package Text::Tags::Parser;

use warnings;
use strict;

sub new {
    my $class = shift;
    bless {}, $class;
}

sub parse_tags {
    my $self   = shift;
    my $string = shift;

    return unless defined $string;

    my @tags;
    my %seen;

    # In this regexp, the actual content of the tag is in the last
    # paren-group which matches in each alternative.
    # Thus it can be accessed as $+
    while (
        $string =~ /\G [\s,]* (?:
                        (") ([^"]*) (?: " | $) |      # double-quoted string
                        (') ([^']*) (?: ' | $) |      # single-quoted string
                        ([^\s,]+)                   # other
		     )/gx
        )
    {
        my $tag       = $+;
        my $is_quoted = $1 || $3;

        # shed explictly quoted empty strings
        next unless length $tag;

        $tag =~ s/^\s+//;
        $tag =~ s/\s+$//;
        $tag =~ s/\s+/ /g;

        # Tags should be unique, but in the right order
        push @tags, $tag unless $seen{$tag}++;
    }

    return @tags;
}

sub join_tags {
    my $self = shift;
    my @tags = @_;
    return $self->_join_tags(undef, @tags);
}

sub join_quoted_tags {
    my $self = shift;
    my @tags = @_;
    return $self->_join_tags(1, @tags);
}

sub _join_tags {
    my $self = shift;
    my $always_quote = shift;
    my @tags = @_;

    my %seen;
    my @quoted_tags;

    for my $tag (@tags) {
        $tag =~ s/^\s+//;
        $tag =~ s/\s+$//;
        $tag =~ s/\s+/ /g;

        next unless length $tag;

        my $quote;

        if ( $tag =~ /"/ and $tag =~ /'/ ) {

            # This is an illegal tag.  Normalize to just single-quotes.
            # Quote it too, though technically the new form might not need it.
            $tag =~ tr/"/'/;
            $quote = q{"};
        } elsif ( $tag =~ /"/ ) {

            # It contains a ", so either it needs to be unquoted or
            # single-quoted
            if ( $tag =~ / / or $tag =~ /,/ or $tag =~ /^"/ or $always_quote) {
                $quote = q{'};
            } else {
                $quote = q{};
            }
        } elsif ( $tag =~ /'/ ) {

            # It contains a ', so either it needs to be unquoted or
            # double-quoted
            if ( $tag =~ / / or $tag =~ /,/ or $tag =~ /^'/ or $always_quote) {
                $quote = q{"};
            } else {
                $quote = q{};
            }
        } elsif ( $tag =~ /[ ,]/ or $always_quote) {

            # By this point we know that it contains no quotes.
            # But it needs to be quoted.
            $quote = q{"};
        } else {

            # No special characters at all!
            $quote = q{};
        }

        # $tag is now fully normalized (both by whitespace and by
        # anti-illegalization).  Have we seen it?

        next if $seen{$tag}++;

        push @quoted_tags, "$quote$tag$quote";
    }

    return join ' ', @quoted_tags;
}

1;    # Magic true value required at end of module
__END__