File Coverage

blib/lib/Cache/Reddit.pm

Criterion	Covered	Total	%
statement	12	38	31.5
branch	0	14	0.0
condition	0	9	0.0
subroutine	4	10	40.0
pod	3	6	50.0
total	19	77	24.6

use strict;
use warnings;
package Cache::Reddit;
$Cache::Reddit::VERSION = '0.03';
#ABSTRACT: a caching API that uses Reddit as the backend

require Exporter;
our @ISA = qw/Exporter/;
our @EXPORT = qw/get set remove/;
use Reddit::Client;


my $session_file = '~/.reddit';
my $reddit       = Reddit::Client->new(
    session_file => $session_file,
    user_agent   => 'Cache::Reddit/0.1',
);

use Storable ();

sub serialize { Storable::nfreeze($_[0]) }

sub deserialize { Storable::thaw($_[0]) }

sub authenticate
{
  die 'Cache::Reddit requires the following environment variables: reddit_username, reddit_password and reddit_subreddit'
    unless $ENV{reddit_username} && $ENV{reddit_password} && $ENV{reddit_subreddit};
  unless ($reddit->is_logged_in) {
      $reddit->login($ENV{reddit_username}, $ENV{reddit_password});
      $reddit->save_session();
  }
}


sub set
{
  my ($value) = @_;

  die 'set() only accepts references' unless $value && ref $value;

  authenticate();

  my $data = serialize($value);

  $reddit->submit_text(
      subreddit => $ENV{reddit_subreddit},
      title     => 'Cache::Reddit::' . (int rand 100000),
      text      => $data,
  );
}


sub get
{
  my $key = shift;

  die 'get() requires a key argument' unless $key;

  authenticate();

  my $data;

  for my $link ( @{$reddit->fetch_links(subreddit => $ENV{reddit_subreddit})->{items}} )
  {
    if ($link->{name} eq $key)
    {
      $data = $link->{selftext};
      last;
    }
  }
  deserialize($data) if $data;
}


sub remove
{
  my $key = shift;
  die 'remove() requires a key argument' unless $key;

  authenticate();

  $reddit->delete_item(name => $key);
  1;
}

1;

__END__