Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

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;

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

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others meditating upon the Monastery: (4)
As of 2024-03-28 13:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found