File Coverage

blib/lib/Twitter/TagGrep.pm

Criterion	Covered	Total	%
statement	6	46	13.0
branch	0	16	0.0
condition			n/a
subroutine	2	9	22.2
pod	6	6	100.0
total	14	77	18.1

package Twitter::TagGrep;

use strict;
use warnings;

our $VERSION = '1.0000';

sub prefix {
  my $self = shift;

  if (defined $_[0]) {
    $self->{prefix} = $_[0];
    undef $self->{tag_regex};
  }
  return $self->{prefix};
}

sub add_prefix {
  my $self = shift;

  $self->{prefix} = join '', $self->{prefix}, @_;
  undef $self->{tag_regex};
  return $self->{prefix};
}

sub tags {
  my $self = shift;

  if (@_) {
    if (ref $_[0] eq 'ARRAY') {
      $self->{tags} = $_[0];
    } else {
      $self->{tags} = [ @_ ];
    }
    undef $self->{tag_regex};
  }

  return @{$self->{tags}};
}

sub add_tag {
  my $self = shift;

  for my $tag (@_) {
    if (ref $tag eq 'ARRAY') {
      push @{$self->{tags}}, @$tag;
    } else {
      push @{$self->{tags}}, $tag;
    }
  }

  undef $self->{tag_regex};
  return @{$self->{tags}};
}


sub grep_tags {
  my $self = shift;
  my $timeline = shift;

  $self->_gen_tag_regex unless $self->{tag_regex};

  return reverse grep {
    my @tags = $_->{text} =~ /$self->{tag_regex}/gi;
    $_->{tags} = \@tags if @tags;
  } @$timeline;
}


sub new {
  my ($class, %params) = @_;

  my $self = {
              prefix    => defined $params{prefix} ? $params{prefix} : '#',
              tags      => [],
              tag_regex => undef,
             };
  bless $self, $class;

  $self->tags($params{tags}) if $params{tags};

  return $self;
}

sub _gen_tag_regex {
  my $self = shift;

  $self->{tag_regex} = '(?:\A|\s)[' . $self->prefix . ']('
                       . (join '|', $self->tags) . ')\b';

#  print $self->{tag_regex}, "\n";
}

=head1 NAME

Twitter::TagGrep - Find messages with selected tags in Twitter timelines

=head1 VERSION

Version 1.00


=head1 SYNOPSIS

    use Twitter::TagGrep;
    use Net::Twitter;

    my $twit = Net::Twitter->new( ... );

    my $tg = Twitter::TagGrep->new( prefix => '#!',
                                    tags => [ 'foo', 'bar' ] );

    my $timeline = $twit->friends_timeline;

    # Get tweets containing one or more of #foo, #bar, !foo, or !bar
    my @matches = $tg->grep_tags($timeline);

    for my $tweet (@matches) {
      print $tweet->{text}, "\n", join(', ', @{$tweet->{tags}}), "\n";
    }

=head1 METHODS

=over

=item C

Initializes and returns a new Twitter::TagGrep object.

Takes the following optional parameters:

=over

=item C

A string defining the set of tag prefixes to recognize.  Defaults to '#'
(hashtags) if not specified.

=item C

Either a single tag to search for or a reference to an array containing
any number of tags to search for.

=back

=item C

If passed a parameter, replaces the set of recognized prefixes.

Returns the set of recognized prefixes as a single string value.

=item C

Appends all parameters to the set of recognized prefixes and returns that
set.

=item C

If passed one or more parameters, sets the list of recognized tags.  Any
array references will add the contents of the referenced array, while other
parameters will be used as-is.

Returns an array of recognized tags.

=item C

As C, but appends to the list of tags rather than replacing it.

=item C

Takes a single scalar parameter referencing a Twitter timeline as returned
by Net::Twitter's *_timeline functions.

Returns an array of tweets found within that timeline which contain at least
one instance of (any character found in the C setting) followed by
(any string listed in the C setting).  This check is case-insensitive.

A list of tags found in each returned tweet is added to it under the "tags"
hash key.

The tag must normally stand alone as a word by itself, but can be matched as a
substring by using regular expression metacharacters in C values.
Wildcard searches may also be done in this fashion, such as using the value
"\w+" to locate all tweets containing one or more tags.

=back

=head1 AUTHOR

Dave Sherohman, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Twitter::TagGrep


The latest version of this module may be obtained from

    git://sherohman.org/tag_grep


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS


=head1 COPYRIGHT & LICENSE

Copyright 2009 Dave Sherohman, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut

1; # End of Twitter::TagGrep