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