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 {
  11         return ();
  12 }
  13
  14 sub vfields {
  15         return ();
  16 }
  17
  18 sub afields {
  19         return ($_[0]->fields(), $_[0]->vfields());
  20 }
  21
  22 sub filter_field {
  23         return $_[2];
  24 }
  25
  26 sub source {
  27         my $self        = shift;
  28
  29         if (@_) {
  30                 $self->{_source} = shift;
  31         }
  32
  33         return $self->{_source};
  34 }
  35
  36
  37 sub _assert {
  38         my $self        = shift;
  39
  40         my $id = $self->get('id') || '';
  41         $id =~ /^[\d\w_-]+$/ or confess "Bad id '$id' [" . ref($self) . '] ';
  42
  43         return $self;
  44 }
  45
  46 sub new {
  47         my $class       = shift;
  48         my %args        = @_;
  49
  50         my $self = bless({ }, $class);
  51
  52         foreach my $k ($self->afields()) {
  53                 $self->{$k} = undef;
  54                 $self->set($k, $args{$k});
  55         }
  56
  57         return $self;
  58 }
  59
  60 sub get {
  61         my $self        = shift;
  62         my $field       = shift;
  63
  64         confess 'get ' . ref($self) . " field '$field'?" unless exists $self->{$field};
  65
  66         return $self->{$field};
  67 }
  68
  69 sub set {
  70         my $self        = shift;
  71         my $field       = shift;
  72         my $value       = shift;
  73
  74         confess 'set ' . ref($self) . " field '$field'?" unless exists $self->{$field};
  75
  76         $self->{$field} = $self->filter_field($field, $value);
  77
  78         return $self->{$field};
  79 }
  80
  81
  82 package Gruta::Data::Topic;
  83
  84 use base 'Gruta::Data::BASE';
  85
  86 sub fields {
  87         return qw(id name editors max_stories internal description);
  88 }
  89
  90 sub filter_field {
  91         my $self        = shift;
  92         my $field       = shift;
  93         my $value       = shift;
  94
  95         # ensure empty numeric values are 0
  96         if ($field =~ /^(max_stories|internal)$/ && !$value) {
  97                 $value = 0;
  98         }
  99
 100         return $value;
 101 }
 102
 103 sub is_editor {
 104         my $self        = shift;
 105         my $user        = shift; # Gruta::Data::User
 106
 107         return $user && ($user->get('is_admin') ||
 108                 ($self->get('editors') || '')
 109                         =~ m{\b$user->get('id')\b}) ? 1 : 0;
 110 }
 111
 112 package Gruta::Data::Story;
 113
 114 use base 'Gruta::Data::BASE';
 115
 116 use Carp;
 117
 118 sub fields {
 119         return qw(id topic_id title date date2 userid format hits ctime toc has_comments full_story content description abstract body);
 120 }
 121
 122 sub filter_field {
 123         my $self        = shift;
 124         my $field       = shift;
 125         my $value       = shift;
 126
 127         # ensure empty numeric values are 0
 128         if ($field =~ /^(hits|ctime)$/ && !$value) {
 129                 $value = 0;
 130         }
 131
 132         return $value;
 133 }
 134
 135 sub _assert {
 136         my $self        = shift;
 137
 138         $self->SUPER::_assert();
 139
 140         my $topic_id = $self->get('topic_id') || '';
 141         $topic_id =~ /^[\d\w_-]+$/ or croak "Bad topic_id";
 142
 143         return $self;
 144 }
 145
 146 sub date {
 147         return Gruta::Data::format_date($_[0]->get('date'), $_[1]);
 148 }
 149
 150 sub date2 {
 151         return Gruta::Data::format_date($_[0]->get('date2'), $_[1]);
 152 }
 153
 154 sub touch {
 155         return $_[0];
 156 }
 157
 158 sub tags {
 159         my $self        = shift;
 160         my @ret         = undef;
 161
 162         if (scalar(@_)) {
 163                 $self->set('tags', [ @_ ]);
 164         }
 165         else {
 166                 @ret = @{ $self->get('tags') };
 167         }
 168
 169         return @ret;
 170 }
 171
 172 sub new_id {
 173         my $self        = shift;
 174
 175         my $id;
 176
 177     my ($s, $m, $h, $d, $M, $y) = localtime(time());
 178
 179     $id = sprintf("%02x%c%c%c%c%02x",
 180         $$ % 256,
 181         (($y + $m) % 25) + 97,
 182         (($d + $M) % 25) + 97,
 183         ($h % 25) + 97,
 184         ($s % 25) + 97,
 185         rand(0xff)
 186     );
 187
 188         return $id;
 189 }
 190
 191 sub is_visible {
 192         my $self        = shift;
 193         my $user        = shift; # Gruta::Data::User
 194
 195         return !$user && $self->get('date') gt Gruta::Data::today() ? 0 : 1;
 196 }
 197
 198
 199 package Gruta::Data::User;
 200
 201 use base 'Gruta::Data::BASE';
 202
 203 sub fields {
 204         return qw(id username email password can_upload is_admin xdate);
 205 }
 206
 207 sub filter_field {
 208         my $self        = shift;
 209         my $field       = shift;
 210         my $value       = shift;
 211
 212         # ensure empty numeric values are 0
 213         if ($field =~ /^(can_upload|is_admin)$/ && !$value) {
 214                 $value = 0;
 215         }
 216
 217         return $value;
 218 }
 219
 220 sub xdate {
 221         return Gruta::Data::format_date($_[0]->get('xdate'), $_[1]);
 222 }
 223
 224 sub password {
 225         my $self        = shift;
 226         my $passwd      = shift;
 227
 228         $self->set('password', Gruta::Data::crypt($passwd));
 229
 230         return $self;
 231 }
 232
 233
 234 package Gruta::Data::Session;
 235
 236 use base 'Gruta::Data::BASE';
 237
 238 sub fields {
 239         return qw(id time user_id ip);
 240 }
 241
 242 sub new {
 243         my $class = shift;
 244
 245         my $sid = time() . $$;
 246
 247         return $class->SUPER::new( id => $sid, time => time(), @_);
 248 }
 249
 250
 251 package Gruta::Data::Template;
 252
 253 use base 'Gruta::Data::BASE';
 254
 255 sub fields {
 256         return qw(id content);
 257 }
 258
 259
 260 package Gruta::Data::Comment;
 261
 262 use base 'Gruta::Data::BASE';
 263
 264 use Carp;
 265
 266 sub fields {
 267         return qw(id topic_id story_id ctime date approved author email content);
 268 }
 269
 270
 271 sub filter_field {
 272         my $self        = shift;
 273         my $field       = shift;
 274         my $value       = shift;
 275
 276         if ($field eq 'approved' && !$value) {
 277                 $value = 0;
 278         }
 279
 280         return $value;
 281 }
 282
 283
 284 sub date {
 285         return Gruta::Data::format_date($_[0]->get('date'), $_[1]);
 286 }
 287
 288 sub new {
 289         my $class = shift;
 290
 291         my $id = sprintf("%08x%04x", time(), $$);
 292
 293         return $class->SUPER::new(
 294         id      => $id,
 295         ctime   => time(),
 296         date    => Gruta::Data::today(),
 297         @_
 298     );
 299 }
 300
 301
 302 package Gruta::Data;
 303
 304 sub format_date {
 305         my $date        = shift;
 306         my $format      = shift;
 307
 308         if (!$date) {
 309                 return '';
 310         }
 311
 312         if ($format) {
 313                 use POSIX;
 314
 315                 my ($y, $m, $d, $H, $M, $S) = ($date =~
 316                         /^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})$/);
 317
 318                 # convert %y to %Y for compatibility
 319                 $format =~ s/%y/%Y/g;
 320
 321                 $format = POSIX::strftime($format, $S, $M, $H,
 322                                         $d, $m - 1, $y - 1900);
 323         }
 324         else {
 325                 $format = $date;
 326         }
 327
 328         return $format;
 329 }
 330
 331
 332 $Gruta::Data::_today = undef;
 333
 334 sub today {
 335         my $format      = shift;
 336
 337         my $date = $Gruta::Data::_today;
 338
 339         if (!$date) {
 340                 my ($S, $M, $H, $d, $m, $y) = (localtime)[0..5];
 341
 342                 $date = sprintf('%04d%02d%02d%02d%02d%02d',
 343                         1900 + $y, $m + 1, $d, $H, $M, $S);
 344
 345                 $Gruta::Data::_today = $date;
 346         }
 347
 348         return Gruta::Data::format_date($date, $format);
 349 }
 350
 351
 352 sub crypt {
 353         my $key         = shift;
 354         my $salt        = shift;
 355
 356         # no salt? pick one at random
 357         if (!$salt) {
 358                 $salt = sprintf('%02d', rand(100));
 359         }
 360
 361         return crypt($key, $salt);
 362 }
 363
 364 1;