/[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

Annotation of /Session.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 159 - (hide annotations)
Sun Aug 5 18:25:53 2007 UTC (11 years, 8 months ago) by dpavlin
File size: 2594 byte(s)
new session format which enables you, the emulator use, to refactor your sessions
1 dpavlin 145 package Session;
2    
3     # Dobrica Pavlinusic, <dpavlin@rot13.org> 08/05/07 14:27:15 CEST
4    
5     use strict;
6     use warnings;
7    
8 dpavlin 159 use Carp qw/confess croak/;
9 dpavlin 145 use Data::Dump qw/dump/;
10     use File::Slurp;
11 dpavlin 159 use POSIX qw/strftime/;
12 dpavlin 145
13     use base qw/Class::Accessor/;
14 dpavlin 159 __PACKAGE__->mk_accessors(qw(session_uuid));
15 dpavlin 145
16    
17     =head1 NAME
18    
19     Session - save or load emulator interactive session
20    
21 dpavlin 159 =head1 DESCRIPTION
22 dpavlin 145
23 dpavlin 159 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 dpavlin 145 =head1 FUNCTIONS
31    
32     =head2 record_session
33    
34 dpavlin 150 $self->record_session( 'name', $value );
35 dpavlin 145
36     =cut
37    
38 dpavlin 159 my $path = 'session.pl';
39    
40     my $last_tick = 0;
41    
42     my $t = 0;
43     my @timeline;
44     my $s;
45    
46 dpavlin 145 sub record_session {
47     my $self = shift;
48 dpavlin 150 my $name = shift || confess "need name";
49 dpavlin 159 my $value = shift || confess "need value";
50 dpavlin 145
51 dpavlin 159 if ( @timeline ) {
52     warn "INFO: Aborting recorderd session\n";
53     @timeline = ();
54     $t = 0;
55     $s = {};
56     }
57    
58 dpavlin 145 my $t = $self->app->ticks;
59 dpavlin 159 my $dt = $t - $last_tick;
60     $last_tick = $t;
61 dpavlin 145
62 dpavlin 159 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 dpavlin 145
68 dpavlin 159 $self->append_to_file($path, 'event(', dump( $dt, $name, $value ),");\n");
69    
70 dpavlin 145 }
71    
72 dpavlin 159 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 dpavlin 145 =head2 load_session
85    
86     $self->load_session( '/path/to/session.pl' );
87    
88     =cut
89    
90     sub load_session {
91     my $self = shift;
92     my $path = shift || confess "no path?";
93    
94 dpavlin 150 if ( ! -r $path ) {
95     warn "WARNING: can't open session $path: $!\n";
96     return;
97     }
98    
99 dpavlin 145 eval read_file( $path );
100 dpavlin 150 warn "session = ",dump( $s );
101 dpavlin 145
102     my ( $from, $to ) = @timeline[0,-1];
103     printf "loaded session %.2f-%.2fs with %d events\n", $from / 1000, $to / 1000, $#timeline + 1;
104     }
105    
106 dpavlin 150 =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 dpavlin 145 =head1 SEE ALSO
137    
138     L<VRac>
139    
140     =cut
141    
142     1;

  ViewVC Help
Powered by ViewVC 1.1.26