package Data::Taxonomy::Tags;

use strict;
use warnings;

use vars qw($VERSION $ERROR);
$VERSION = '0.04';

use overload
	'""'     => sub { shift->as_string },
	fallback => 1;

# Constants for separator and category
use constant SPLIT  => 0;
use constant JOIN   => 1;

=head1 NAME

Data::Taxonomy::Tags - Represents a set of tags for any item

=head1 SYNOPSIS

    use Data::Taxonomy::Tags;
    
    my $tags = Data::Taxonomy::Tags->new('perl tags cpan module system:meta');
    
    print $_, "\n" for $tags->tags;
    
    print $_, "\n" for $tags->categories;

=head1 DESCRIPTION

Data::Taxonomy::Tags will basically take care of managing tags for an
item easier.  You provide it with a string of tags and it'll allow you
to call methods to get all the tags and categories as well as add and
delete tags from the list.  On error

=head2 Methods

=over 12

=item new($string[,\%options])

The first argument is a string of tags.  The second argument, which is
optional, is a hashref of options.

Returns a Data::Taxonomies::Tags object;

=over 24

=item C<separator => ['\s+', ' ']>

Specifies the regex pattern which will be used to C<split> the tags
apart and the character(s) used between tags when converting the object
back to a string.  Make sure to escape any special characters in the
regex pattern.

If the value is not an arrayref, then the same value is used for both
operations.

Defaults to C<['\s+', ' ']>.

=item C<category => [':', ':']>

Specifies the regex pattern which will be used to C<split> the tag
name from it's optional category and the character(s) used between
the category and tag when converting to a string.  Make sure to escape
any special characters in the regex pattern.

If the value is not an arrayref, then the same value is used for both
operations.

Defaults to C<[':', ':']>.

=back

=cut
sub new {
    my ($class, $tags, $opt) = @_;
    
    if (not defined $tags) {
        return __PACKAGE__->_set_error('Invalid arguments');
    }
    
    my $self = bless {
        input       => $tags,
        separator   => ['\s+', ' '],
        category    => [':', ':'],
    }, $class;
    
    if (defined $opt) {
        for (qw(separator category)) {
            if (defined $opt->{$_}) {
                $self->{$_} = ref $opt->{$_} eq 'ARRAY' && @{$opt->{$_}} == 2
                                ? $opt->{$_}
                                : [$opt->{$_}, $opt->{$_}];
            }
        }
    }
    
    $self->add_to_tags($tags);
    
    return $self;
}

=item tags

Returns an array or arrayref (depending on context) of L<Data::Taxonomy::Tags::Tag>
objects.

=cut
sub tags { return wantarray ? @{$_[0]->{tags}} : $_[0]->{tags}; }

=item add_to_tags($tags)

Processes the string and adds the tag(s) to the object.

=cut
sub add_to_tags {
    my ($self, $input) = @_;
    my @tags = split /$self->{separator}[SPLIT]/, $input;
    
    $_ = Data::Taxonomy::Tags::Tag->new($_, { separator => $self->{category} })
        for @tags;
    
    push @{$self->{tags}}, @tags;
}

=item remove_from_tags($tags)

Processes the string and removes the tag(s) from the object.

=cut
sub remove_from_tags {
    my ($self, $input) = @_;
    my %tags = map { $_ => 1 } split /$self->{separator}[SPLIT]/, $input;
    
    @{$self->{tags}} = grep { !$tags{$_} } $self->tags;
}

=item remove_category($category)

Removes all tags with the specified category.

=cut
sub remove_category {
    my ($self, $category) = @_;
    
    {
        no warnings 'uninitialized';
        @{$self->{tags}} = grep { $_->category ne $category } $self->tags;
    }
}

=item categories

Returns an array or arrayref (depending on context) of the unique categories.

=cut
sub categories {
    my $self = shift;

    my %seen;
    my @cats = grep { defined $_ && !$seen{$_}++ }
                map { $_->category }
                    $self->tags;

    return wantarray ? @cats : \@cats;
}

=item tags_with_category($category)

Returns an array or arrayref (depending on context) of the tags with the
specified category

=cut
sub tags_with_category {
    my ($self, $category) = @_;
    
    my @tags;
    {
        no warnings 'uninitialized';

        @tags =  map { $_->[1] }
                grep { $_->[0] eq $category }
                 map { [$_->category, $_] }
                     $self->tags;
    }

    return wantarray ? @tags : \@tags;
}

=item error

The C<error> method returns the latest error after clearing it internally.
If you call C<error> and want to use the message again later, be sure to
store it yourself.

=cut
sub error {
    my $e = $ERROR;
    undef $ERROR;
    return $e;
}

=item as_string

Returns the tag list as a string (that is, what was given to the constructor).
Overloading is used as well to automatically call this method if the object
is used in a string context.

=cut
sub as_string {
    my $self = shift;
    
    return defined $self
            ? join $self->{separator}[JOIN], $self->tags
            : undef;
}

sub _set_error {
    $ERROR = join '', @_[1..$#_];
    return;
}

package Data::Taxonomy::Tags::Tag;

use overload
	'""'     => sub { shift->as_string },
	fallback => 1;

# Constants for separator and category
use constant SPLIT  => 0;
use constant JOIN   => 1;

=head1 NAME

Data::Taxonomy::Tags::Tag - Represents a single tag

=head1 SYNOPSIS

    print $tag->name, " (category: ", $tag->category, ")\n";

=head1 DESCRIPTION

Data::Taxonomy::Tags::Tag represents a single tag for a Data::Taxonomy::Tags
object.

=head2 Methods

=over 12

=cut
sub new {
    my ($class, $tag, $opt) = @_;

    my $self = bless {
        input       => $tag,
        separator   => $opt->{separator},
    }, $class;
    
    $self->_process;
    
    *name = \&tag;
    
    return $self;
}

=item tag

=item name

Returns the name of the tag (that is, the tag itself) sans the category bit.

=cut
sub tag {
    my ($self, $v) = @_;
    $self->{tag} = $v
        if defined $v;
    return $self->{tag};
}

=item category

Returns the category the tag is in.  If there is no category, then undef
is returned;

=cut
sub category {
    my ($self, $v) = @_;
    $self->{category} = $v
        if defined $v;
    return $self->{category};
}

sub _process {
    my $self = shift;
    my ($one, $two) = split /$self->{separator}[SPLIT]/, $self->{input};
    if (defined $one and defined $two) {
        $self->tag($two);
        $self->category($one);
    }
    elsif (defined $one and not defined $two) {
        $self->tag($one);
    }
    else {
        # Ack!  Weird data.
        $self->tag($self->{input});
    }
}

=item as_string

Returns the full tag as a string (that is, the category, the category seperator,
and the tag name all concatenated together).  Overloading is used as well to
automatically call this method if the object is used in a string context.

=cut
sub as_string {
    my $self = shift;
        
    return defined $self
            ? defined $self->category
                    ? $self->category . $self->{separator}[JOIN] . $self->tag
                    : $self->tag
            : undef;
}

42;