comment on

Tags are the latest taxonomic trend, though some prefer to call tags a "folksonomy" due to the inherent lack of defined standards. Whatever you call it, tags are useful for organizing information and are found in an ever-increasing number of web applications; perhaps the two most notable are del.icio.us and Flickr.

A collection of tags is normally represented by stringing them together separated by spaces, and this is often the method of storing them in the database. However, often you'd like to be able to deal with the collection as individual items, and although a split isn't difficult, it can get tiresome. I looked on CPAN a while ago for a module to handle the minor details of working with tags such as splitting and joining and what not, but was surprised when I couldn't find one. That's how the module below came into being (even though I put it on hold for a few months).

Let me know what you think about it, any improvements, et cetera. I'd also like comments on the name (Data::Taxonomy::Tags); I'm not that fond of it. Perhaps Data::Collection::Tags? Text::Tags? Something else?

The code is below:

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 objec
+t
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::Taxonom
+y::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->{cat
+egory} })
        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]/, $inp
+ut;
    
    @{$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->t
+ags;
    }
}

=item categories

Returns an array or arrayref (depending on context) of the unique cate
+gories.

=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 t
+he
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 interna
+lly.
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 const
+ructor).
Overloading is used as well to automatically call this method if the o
+bject
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 categor
+y 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 und
+ef
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 w
+ell to
automatically call this method if the object is used in a string conte
+xt.

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

42;
[download]

And of course, I'll be adding the standard boilerplate stuff (mostly POD) before uploading it to CPAN.

In reply to RFC: Data::Taxonomy::Tags by The Mad Hatter

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.


go ahead... be a heretic
	PerlMonks