Context.pm

   1 #**************************************************************************
   2 #   Copyright (C) 2009 by Michael Andreen <harvATruinDOTnu>               *
   3 #                                                                         *
   4 #   This program is free software; you can redistribute it and/or modify  *
   5 #   it under the terms of the GNU General Public License as published by  *
   6 #   the Free Software Foundation; either version 2 of the License, or     *
   7 #   (at your option) any later version.                                   *
   8 #                                                                         *
   9 #   This program is distributed in the hope that it will be useful,       *
  10 #   but WITHOUT ANY WARRANTY; without even the implied warranty of        *
  11 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *
  12 #   GNU General Public License for more details.                          *
  13 #                                                                         *
  14 #   You should have received a copy of the GNU General Public License     *
  15 #   along with this program; if not, write to the                         *
  16 #   Free Software Foundation, Inc.,                                       *
  17 #   51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.         *
  18 #**************************************************************************/
  19
  20 package NDIRC::Context;
  21 use strict;
  22 use warnings;
  23 use feature ':5.10';
  24
  25 use Moose;
  26 use namespace::autoclean;
  27
  28 use Set::Object ();
  29
  30 has channel => (
  31         is => 'ro',
  32         isa => 'Str',
  33         required => 1
  34 );
  35
  36 has roles => (
  37         is => 'ro',
  38         isa => 'Object',
  39         lazy_build => 1
  40 );
  41
  42 has uid => (
  43         is => 'ro',
  44         isa => 'Int',
  45         lazy_build => 1
  46 );
  47
  48 has username => (
  49         is => 'ro',
  50         isa => 'Str',
  51         lazy_build => 1
  52 );
  53
  54 has disp => (
  55         is => 'ro',
  56         isa => 'Object',
  57         required => 1
  58 );
  59
  60 has model => (
  61         is => 'ro',
  62         isa => 'Object',
  63         required => 1
  64 );
  65
  66 has bot => (
  67         is => 'ro',
  68         isa => 'Object',
  69         required => 1
  70 );
  71
  72 sub assert_user_roles {
  73         my ($self,@roles) = @_;
  74         return 1 unless @roles;
  75
  76         my $need = Set::Object->new(@roles);
  77
  78         if ($self->roles->superset($need)){
  79                 return 1;
  80         }
  81
  82         die "Access denied";
  83 }
  84
  85 sub check_user_roles {
  86         my ($self,@roles) = @_;
  87
  88         local $@;
  89         eval { $self->assert_user_roles(@roles) };
  90 }
  91
  92 sub reply {
  93 }
  94
  95 sub message {
  96 }
  97
  98 sub replyId {
  99 }
 100
 101 sub intel_log {
 102         my ($c,$planet, $message) = @_;
 103         my $log = $c->model->prepare_cached(q{
 104 INSERT INTO forum_posts (ftid,uid,message) VALUES(
 105         (SELECT ftid FROM planets WHERE pid = $3),$1,$2)
 106                 });
 107         $log->execute($c->uid,$message,$planet);
 108 }
 109
 110 sub def_log {
 111         my ($c,$call, $message) = @_;
 112         my $log = $c->model->prepare(q{
 113 INSERT INTO forum_posts (ftid,uid,message) VALUES(
 114         (SELECT ftid FROM calls WHERE call = $3),$1,$2)
 115                 });
 116         $log->execute($c->uid,$message,$call);
 117 }
 118
 119 sub _build_roles {
 120         my ($self) = @_;
 121
 122         my $query = $self->model->prepare(q{
 123 SELECT role FROM group_roles
 124 WHERE gid IN (SELECT gid FROM groupmembers JOIN users USING (uid)
 125         WHERE uid = $1)
 126                 });
 127         $query->execute($self->uid);
 128
 129         my @roles;
 130         while (my $group = $query->fetchrow_hashref){
 131                 push @roles,$group->{role};
 132         }
 133         return Set::Object->new(@roles);
 134 }
 135
 136 sub _build_uid {
 137         my ($self) = @_;
 138
 139         return -4;
 140 }
 141
 142 sub _build_username {
 143         my ($self) = @_;
 144
 145         my $query = $self->model->prepare(q{
 146 SELECT username FROM users
 147 WHERE uid = $1
 148                 });
 149         $query->execute($self->uid);
 150
 151         if (my ($username) = $query->fetchrow_array){
 152                 $query->finish;
 153                 return $username;
 154         }
 155         return "Anonymous";
 156 }
 157
 158 sub valuecolor {
 159         shift @_;
 160         my $s = $_;
 161         return $s;
 162 }
 163
 164 __PACKAGE__->meta->make_immutable;
 165 1;