perlbuut-pastebin/lib/App/Model/Paste.pm

package App::Model::Paste;

use strict;
use warnings;

use DBI;
use App::Config;
use Mojo::Base '-base';
use DateTime;
use Mojo::Pg;
use Regexp::Assemble;

# TODO config for dbname
# has 'dbh' => sub {DBI->connect("dbi:SQLite:dbname=pastes.db", "", "", {RaiseError => 1, sqlite_unicode => 1})};
my $cfg = App::Config::get_config('database');

has 'pg' => sub {
  Mojo::Pg->new($cfg->{dsc});
};

has 'asndbh' => sub {DBI->connect("dbi:SQLite:dbname=asn.db", "", "", {RaiseError => 1, sqlite_unicode => 1})};

sub get_word_list {
  my $self = shift;
  my ($id) = @_;

  my $word_counts = $self->pg->db->query("
  WITH vector_decomp AS (
    SELECT unnest(full_document_tsvector) AS vectors FROM posts WHERE id = ?
	)
  SELECT (vectors).lexeme as word, array_length((vectors).weights, 1) as word_count FROM vector_decomp
  ", $id)->hashes;

  return $word_counts->each;
}

sub insert_pastebin {
  my $self = shift;
  my ($paste, $who, $what, $where, $expire, $lang, $ip) = @_;
 
  $expire = undef if !$expire; # make sure it's null if it's empty

  my $id = $self->pg->db->insert('posts', 
    {
      paste => $paste, 
      who => $who, 
      where => $where, 
      when => time(), 
      expiration => $expire, 
      language => $lang, 
      ip => $ip
    }, {returning => 'id'})->hash->{id};


  # TODO this needs to retry when it fails.
  my @chars = ('a'..'z', 1..9);
  my $slug = join '', map {$chars[rand() *@chars]} 1..6;

  $self->pg->db->insert(
    'slugs',
    {
      post_id => $id,
      slug => $slug
    }
  );

  return ($slug, $id);
}

sub get_paste {
  my ($self, $pasteid) = @_;

  my $row = $self->pg->db->query(q{
    SELECT p.* 
      FROM posts p 
      LEFT JOIN slugs s ON p.id = s.post_id 
      WHERE s.slug = ?
      ORDER BY s.slug DESC 
      LIMIT 1
      }, $pasteid)->hash;

  my $when = delete $row->{when};

  if ($when) {
    my $whendt = DateTime->from_epoch(epoch => $when);

    if (!$row->{expiration} || $whendt->clone()->add(hours => $row->{expiration}) >= DateTime->now()) {
      $row->{when} = $whendt->iso8601;
      return $row;
    } else {
      return undef;
    }
  } else {
    return undef;
  }
}

sub banned_word_list_re {
  my $self = shift;

  my $data = $self->pg->db->select(
      'banned_words', 
      ['word'], 
      {-not_bool => 'deleted'})
    ->hashes
    ->map(sub { quotemeta $_->{word} });

  my $ra = Regexp::Assemble->new();
  $ra->add(@$data);
  my $re = $ra->re;

  return $re;
}

sub get_asn_for_ip {
  my ($self, $ip) = @_;

  my $data = $self->pg->db->select(
      'asn', 
      ['asn'], 
      {start => {'<=' => $ip},
       end => {'>=' => $ip}})
    ->hashes
    ->map(sub { $_->{asn} });

  return $data->[0];
}

sub is_banned_ip {
  my ($self, $_ip) = @_;
  return 0 if ($_ip =~ /:/); # ignore ipv6 stuff for now
  my $ip = sprintf("%03d.%03d.%03d.%03d", split(/\./, $_ip));
  
  my $asn = $self->get_asn_for_ip($ip);
  
  my $row_ar = $self->pg->db->query(
    q{
    SELECT 1
    FROM banned_ips i 
    LEFT JOIN banned_asns a ON 1=1 
    WHERE (i.ip = ? AND NOT i.deleted) OR (a.asn = ? AND NOT a.deleted)
    }, 
    $ip, $asn)->hashes;

  return 0+@$row_ar;
}

1;