Gruta/Data.pm

   1 package Gruta::Data;
   2
   3 use strict;
   4 use warnings;
   5
   6 package Gruta::Data::BASE;
   7
   8 use Carp;
   9
  10 sub fields { return (); }
  11 sub vfields { return (); }
  12 sub afields { return ($_[0]->fields(), $_[0]->vfields()); }
  13
  14 sub source {
  15         my $self        = shift;
  16
  17         if (@_) {
  18                 $self->{_source} = shift;
  19         }
  20
  21         return $self->{_source};
  22 }
  23
  24
  25 sub _assert {
  26         my $self        = shift;
  27
  28         my $id = $self->get('id') || '';
  29         $id =~ /^[\d\w_-]+$/ or croak "Bad id [$id]";
  30
  31         return $self;
  32 }
  33
  34 sub new {
  35         my $class       = shift;
  36         my %args        = @_;
  37
  38         my $self = bless({ }, $class);
  39
  40         foreach my $k ($self->afields()) {
  41                 $self->{$k} = $args{$k};
  42         }
  43
  44         return $self;
  45 }
  46
  47 sub get {
  48         my $self        = shift;
  49         my $field       = shift;
  50
  51         croak 'get ' . ref($self) . " field '$field'?" unless exists $self->{$field};
  52
  53         return $self->{$field};
  54 }
  55
  56 sub set {
  57         my $self        = shift;
  58         my $field       = shift;
  59
  60         croak 'set ' . ref($self) . " field '$field'?" unless exists $self->{$field};
  61
  62         $self->{$field} = shift;
  63
  64         return $self->{$field};
  65 }
  66
  67
  68 package Gruta::Data::Topic;
  69
  70 use base 'Gruta::Data::BASE';
  71
  72 sub fields { return qw(id name editors max_stories internal); }
  73
  74 sub is_editor {
  75         my $self        = shift;
  76         my $user        = shift; # Gruta::Data::User
  77
  78         return $user && ($user->get('is_admin') ||
  79                 $self->get('editors') =~ m{\b$user->get('id')\b}) ? 1 : 0;
  80 }
  81
  82 package Gruta::Data::Story;
  83
  84 use base 'Gruta::Data::BASE';
  85
  86 use Carp;
  87
  88 sub fields { return qw(id topic_id title date date2 userid format hits ctime content); }
  89 sub vfields { return qw(abstract body); }
  90
  91 sub _assert {
  92         my $self        = shift;
  93
  94         $self->SUPER::_assert();
  95
  96         my $topic_id = $self->get('topic_id') || '';
  97         $topic_id =~ /^[\d\w_-]+$/ or croak "Bad topic_id";
  98
  99         return $self;
 100 }
 101
 102 sub date { return Gruta::Data::format_date($_[0]->get('date'), $_[1]); }
 103 sub date2 { return Gruta::Data::format_date($_[0]->get('date2'), $_[1]); }
 104
 105 sub touch { return $_[0]; }
 106
 107 sub tags {
 108         my $self        = shift;
 109         my @ret         = undef;
 110
 111         if (scalar(@_)) {
 112                 $self->set('tags', [ @_ ]);
 113         }
 114         else {
 115                 @ret = @{ $self->get('tags') };
 116         }
 117
 118         return @ret;
 119 }
 120
 121 sub new_id {
 122         my $self        = shift;
 123
 124         return sprintf ('%08x', int(rand(0xffffffff)));
 125 }
 126
 127 sub is_visible {
 128         my $self        = shift;
 129         my $user        = shift; # Gruta::Data::User
 130
 131         return !$user && $self->get('date') > Gruta::Data::today() ? 0 : 1;
 132 }
 133
 134
 135 package Gruta::Data::User;
 136
 137 use base 'Gruta::Data::BASE';
 138
 139 sub fields { return qw(id username email password can_upload is_admin xdate); }
 140 sub vfields { return qw(sid); }
 141
 142 sub xdate { return Gruta::Data::format_date($_[0]->get('xdate'), $_[1]); }
 143
 144 sub password {
 145         my $self        = shift;
 146         my $passwd      = shift;
 147
 148         $self->set('password', Gruta::Data::crypt($passwd));
 149
 150         return $self;
 151 }
 152
 153
 154 package Gruta::Data::Session;
 155
 156 use base 'Gruta::Data::BASE';
 157
 158 sub fields { return qw(id time user_id ip); }
 159
 160 sub new {
 161         my $class = shift;
 162
 163         my $sid = time() . $$;
 164
 165         return $class->SUPER::new( id => $sid, time => time(), @_);
 166 }
 167
 168
 169 package Gruta::Data;
 170
 171 sub format_date {
 172         my $date        = shift;
 173         my $format      = shift;
 174
 175         if ($format) {
 176                 my ($y, $m, $d, $H, $M, $S) = ($date =~
 177                         /^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/);
 178
 179                 $format =~ s/%Y/$y/g;
 180                 $format =~ s/%y/$y/g;
 181                 $format =~ s/%m/$m/g;
 182                 $format =~ s/%d/$d/g;
 183                 $format =~ s/%H/$H/g;
 184                 $format =~ s/%M/$M/g;
 185                 $format =~ s/%S/$S/g;
 186         }
 187         else {
 188                 $format = $date;
 189         }
 190
 191         return $format;
 192 }
 193
 194
 195 sub today {
 196         my $format      = shift;
 197
 198         my ($S,$M,$H,$d,$m,$y) = (localtime)[0..5];
 199
 200         my $date = sprintf('%04d%02d%02d%02d%02d%02d',
 201                 1900 + $y, $m + 1, $d, $H, $M, $S);
 202
 203         return Gruta::Data::format_date($date, $format);
 204 }
 205
 206
 207 sub crypt {
 208         my $key         = shift;
 209         my $salt        = shift;
 210
 211         # no salt? pick one at random
 212         if (!$salt) {
 213                 $salt = sprintf('%02d', rand(100));
 214         }
 215
 216         return crypt($key, $salt);
 217 }
 218
 219 1;