/[VRac]/Session.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /Session.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 145 by dpavlin, Sun Aug 5 13:27:27 2007 UTC revision 159 by dpavlin, Sun Aug 5 18:25:53 2007 UTC
# Line 5  package Session; Line 5  package Session;
5  use strict;  use strict;
6  use warnings;  use warnings;
7    
8  use Carp qw/confess/;  use Carp qw/confess croak/;
9  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
10  use File::Slurp;  use File::Slurp;
11    use POSIX qw/strftime/;
12    
13  use base qw/Class::Accessor/;  use base qw/Class::Accessor/;
14  #__PACKAGE__->mk_accessors(qw());  __PACKAGE__->mk_accessors(qw(session_uuid));
15    
16    
17  =head1 NAME  =head1 NAME
18    
19  Session - save or load emulator interactive session  Session - save or load emulator interactive session
20    
21  =cut  =head1 DESCRIPTION
22    
23    Sessions are simple perl programs using one function C<event>
24    
25      event( $ticks_wait, 'name', $hash );
26    
27    Using this, you can refactor your sessions or use perl constructs around
28    them.
29    
30  =head1 FUNCTIONS  =head1 FUNCTIONS
31    
32  =head2 record_session  =head2 record_session
33    
34    $self->record_session( 'name', $values );    $self->record_session( 'name', $value );
35    
36  =cut  =cut
37    
38    my $path = 'session.pl';
39    
40  my $last_tick = 0;  my $last_tick = 0;
41    
42    my $t = 0;
43    my @timeline;
44    my $s;
45    
46  sub record_session {  sub record_session {
47          my $self = shift;          my $self = shift;
48          my $name = shift || confess "no name?";          my $name = shift || confess "need name";
49            my $value = shift || confess "need value";
50    
51            if ( @timeline ) {
52                    warn "INFO: Aborting recorderd session\n";
53                    @timeline = ();
54                    $t = 0;
55                    $s = {};
56            }
57    
58          my $t = $self->app->ticks;          my $t = $self->app->ticks;
59          my $dt = $t - $last_tick;          my $dt = $t - $last_tick;
60          $last_tick = $t;          $last_tick = $t;
61    
62          $self->append_to_file('session.pl', "\$s->{$t}->{$name} = ", dump( @_ ),";\n");          if ( ! $self->session_uuid ) {
63                    my $uuid = strftime('%Y-%m-%d %H:%M:%S',localtime);
64                    $self->append_to_file($path, "# $uuid\n");
65                    $self->session_uuid( $uuid );
66            }
67    
68            $self->append_to_file($path, 'event(', dump( $dt, $name, $value ),");\n");
69    
70    }
71    
72    sub event {
73            my $dt = shift || croak 'expected dt';
74            my $name = shift || croak 'expected name';
75            my $value = shift || croak 'expected value';
76    
77            $t += $dt;
78            push @timeline, $t;
79            $s->{$t}->{$name} = $value;
80    
81            warn "## created event($dt,$name,",dump($value),")\n";
82  }  }
83    
84  =head2 load_session  =head2 load_session
# Line 51  sub load_session { Line 91  sub load_session {
91          my $self = shift;          my $self = shift;
92          my $path = shift || confess "no path?";          my $path = shift || confess "no path?";
93    
94          my $s;          if ( ! -r $path ) {
95          eval read_file( $path );                  warn "WARNING: can't open session $path: $!\n";
96          warn "s = ",dump( $s );                  return;
97            }
98    
99          my @timeline = sort { $a <=> $b } keys %$s;          eval read_file( $path );
100            warn "session = ",dump( $s );
101    
102          my ( $from, $to ) = @timeline[0,-1];          my ( $from, $to ) = @timeline[0,-1];
103          printf "loaded session %.2f-%.2fs with %d events\n", $from / 1000, $to / 1000, $#timeline + 1;          printf "loaded session %.2f-%.2fs with %d events\n", $from / 1000, $to / 1000, $#timeline + 1;
104  }  }
105    
106    =head2 session_event
107    
108      my $v = $self->session_event('key_pressed');
109    
110    =cut
111    
112    sub session_event {
113            my $self = shift;
114    
115            return unless @timeline;
116    
117            my $name = shift || confess "no name?";
118    
119            my $t = $self->app->ticks;
120    
121            # do we have events to trigger?
122            return if ( $t < $timeline[0] );
123    
124            my $e_t = $timeline[0];
125    
126            # do we have next event and should we take it?
127            if ( $#timeline > 0 && $t > $timeline[1] ) {
128                    shift @timeline;
129                    $e_t = $timeline[0];
130                    warn "session_event $e_t $name ",dump( $s->{$e_t}->{$name} )," left ", $#timeline+1, " events\n";
131            }
132    
133            return $s->{$e_t}->{$name};
134    }
135    
136  =head1 SEE ALSO  =head1 SEE ALSO
137    
138  L<VRac>  L<VRac>
Legend:
Removed from v.145  
changed lines
  Added in v.159
  ViewVC Help
Powered by ViewVC 1.1.26