Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Feed objects!

  • Loading branch information...
commit d91c07102e121d1f8fdf9f28d864501018330f42 1 parent fe0cf45
authored July 16, 2010
2  scratch/perl/kiokupipe/lib/Event.pm
... ...
@@ -1,5 +1,5 @@
1 1
 package Event;
2  
-use Moose;
  2
+use KiokuDB::Class;
3 3
 use MooseX::Types::DateTime;
4 4
 
5 5
 has 'user' => (
83  scratch/perl/kiokupipe/lib/Feed.pm
... ...
@@ -0,0 +1,83 @@
  1
+package Feed;
  2
+use KiokuDB::Class;
  3
+use MooseX::Types::DateTime;
  4
+use Event;
  5
+use List;
  6
+use Scalar::Util 'refaddr';
  7
+
  8
+has 'store_as' => (
  9
+    is  => 'rw',
  10
+    isa => 'Maybe[Str]',
  11
+);
  12
+
  13
+has from_feed => (
  14
+    is  => 'ro',
  15
+    isa => 'Maybe[Str]',
  16
+);
  17
+
  18
+has list => (
  19
+    is      => 'rw',
  20
+    isa     => 'List',
  21
+    default => sub { List->empty },
  22
+);
  23
+
  24
+has make_list => (
  25
+    is  => 'rw',
  26
+    isa => 'CodeRef',
  27
+);
  28
+
  29
+has from_feed_up_to => (
  30
+    is  => 'rw',
  31
+    isa => 'Maybe[Event]',
  32
+);
  33
+
  34
+has from_root_up_to => (
  35
+    is => 'rw',
  36
+    isa => 'Maybe[Event]',
  37
+);
  38
+
  39
+sub add_event {
  40
+    my ($self, $event) = @_;
  41
+    $self->list( $self->list->prepend($event) );
  42
+}
  43
+
  44
+sub store {
  45
+    my ($self, $kioku) = @_;
  46
+
  47
+    my $store_as = $self->store_as or return;
  48
+    $kioku->store( $store_as, $self );
  49
+}
  50
+
  51
+sub up_to_date {
  52
+    my ($self, $kioku, $root) = @_;
  53
+
  54
+    return 1 unless $self->from_feed;     # root list cannot be updated in this way
  55
+    return unless $self->from_root_up_to; # if new, then must be updated!
  56
+                                          # check if it's been updated
  57
+    return 1 if refaddr $root->list->head == refaddr $self->from_root_up_to;
  58
+}
  59
+
  60
+sub update {
  61
+    my ($self, $kioku, $root) = @_;
  62
+    $root ||= $kioku->lookup('root');
  63
+
  64
+    return if $self->up_to_date( $kioku, $root );
  65
+
  66
+    my $from = $kioku->lookup( $self->from_feed );
  67
+    $from->update($kioku, $root);
  68
+
  69
+    my $from_feed_up_to = $self->from_feed_up_to;
  70
+    my $new = $from_feed_up_to ?
  71
+        $from->list->While( sub { refaddr $_[0] != refaddr $from_feed_up_to })
  72
+        : $from->list;
  73
+
  74
+    my $new_list = $self->make_list->( $new );
  75
+
  76
+    my $whole_list = $new_list->concat($self->list);
  77
+
  78
+    $self->list($whole_list);
  79
+    $self->from_feed_up_to( $from->list->head );
  80
+    $self->from_root_up_to( $root->list->head );
  81
+}
  82
+
  83
+1;
10  scratch/perl/kiokupipe/lib/List.pm
@@ -116,6 +116,11 @@ sub take {
116 116
     return () unless $count;
117 117
     return ($list->head, $list->tail->take($count-1));
118 118
 }
  119
+sub Take { # listy version
  120
+    my ($list, $count) = @_;
  121
+    return $list->empty unless $count;
  122
+    return List->node($list->head, $list->tail->Take($count-1));
  123
+}
119 124
 
120 125
 sub While {
121 126
     my ($list, $f) = @_;
@@ -137,9 +142,14 @@ sub isEmpty { 1 }
137 142
 sub head  { die "Empty lists have no head" }
138 143
 sub tail  { die "Empty lists have no tail" }
139 144
 sub take  { return () }
  145
+sub Take  { return shift }
140 146
 sub Map   { return shift }
141 147
 sub Grep  { return shift }
142 148
 sub While { return __PACKAGE__->empty }
  149
+sub concat {
  150
+    my ($self, $list) = @_;
  151
+    return $list;
  152
+}
143 153
 sub Foldl {
144 154
     my ($self, $f, $init) = @_;
145 155
     return $init;
2  scratch/perl/kiokupipe/test2.pl
@@ -42,7 +42,6 @@
42 42
     }
43 43
 }
44 44
 
45  
-
46 45
 {
47 46
     my $kioku = KiokuDB->connect('hash');
48 47
     my $scope = $kioku->new_scope;
@@ -53,6 +52,7 @@
53 52
     $kioku->store(list => $list);
54 53
 
55 54
     my $completions = $kioku->lookup('list')->Grep( sub { $_[0]->action eq 'completed' } );
  55
+
56 56
     my $high_score  = $completions->Grep( sub { $_[0]->object >= 80 } );
57 57
 
58 58
     $kioku->store(high_scores => $high_score);
91  scratch/perl/kiokupipe/test3.pl
... ...
@@ -0,0 +1,91 @@
  1
+#!/usr/bin/perl
  2
+
  3
+use strict; use warnings;
  4
+use List;
  5
+use Data::Dumper;
  6
+local $Data::Dumper::Indent = 1;
  7
+local $Data::Dumper::Maxdepth = 2;
  8
+
  9
+# dummy modules for things we want to run feeds about
  10
+use Feed;
  11
+use Event;
  12
+use User;
  13
+use Module;
  14
+use DateTime;
  15
+
  16
+use KiokuDB;
  17
+
  18
+{
  19
+    my @modules = map { Module->new(id=>$_) } 1..10;
  20
+    my @users   = map { User  ->new(id=>$_) } 1..10;
  21
+
  22
+    sub make_event {
  23
+        my $date = shift || DateTime->now;
  24
+        my $event = Event->new(
  25
+            datestamp => $date,
  26
+            user      => $users[ int(rand(10)) ],
  27
+            subject   => $modules[ int(rand(10)) ],
  28
+
  29
+            ((rand > 0.5) ? 
  30
+            (
  31
+                action    => 'completed',
  32
+                object    => int(rand(100)),
  33
+            )
  34
+            :
  35
+            (
  36
+                action    => 'started',
  37
+            ))
  38
+        );
  39
+    }
  40
+    sub make_event_list {
  41
+        my $date = shift || DateTime->now;
  42
+        return List->node(  
  43
+            make_event($date),
  44
+            sub { make_event_list($date->clone->subtract( days => 1)) }
  45
+            );
  46
+    }
  47
+}
  48
+
  49
+{
  50
+    my $kioku = KiokuDB->connect('hash');
  51
+    my $scope = $kioku->new_scope;
  52
+
  53
+    my $list = make_event_list()->Take(20); 
  54
+
  55
+    my $root_list = Feed->new( list => $list, store_as => 'root' );
  56
+    $root_list->store($kioku);
  57
+
  58
+    my $completions = Feed->new(
  59
+        store_as => 'completions',
  60
+        from_feed => 'root',
  61
+        make_list => sub {
  62
+            my $root = shift;
  63
+            $root->Grep( sub { $_[0]->action eq 'completed' } );
  64
+        },
  65
+    );
  66
+    $completions->update($kioku);
  67
+    $completions->store($kioku);
  68
+
  69
+    my $high_score = Feed->new(
  70
+        store_as => 'high_score',
  71
+        from_feed => 'completions',
  72
+        make_list => sub {
  73
+            my $completions = shift;
  74
+            $completions->Grep( sub { $_[0]->object >= 80 } );
  75
+        }
  76
+    );
  77
+    $high_score->update($kioku);
  78
+    $high_score->store($kioku);
  79
+
  80
+    my $h2 = $kioku->lookup( 'high_score' );
  81
+    warn Dumper( [ $h2->list->take(2) ] );
  82
+
  83
+    # now, let's add some more events
  84
+
  85
+    for (1..10) {
  86
+        $root_list->add_event( make_event() );
  87
+    }
  88
+
  89
+    $high_score->update($kioku);
  90
+    warn Dumper( [ $h2->list->take(5) ] ); # may be different from above
  91
+}

0 notes on commit d91c071

Please sign in to comment.
Something went wrong with that request. Please try again.