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

Contents of /Session.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 187 - (show annotations)
Sun Sep 30 19:53:59 2007 UTC (11 years, 8 months ago) by dpavlin
File size: 2866 byte(s)
call debug only if we can
1 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 use Carp qw/confess croak/;
9 use Data::Dump qw/dump/;
10 use File::Slurp;
11 use POSIX qw/strftime/;
12
13 use base qw/Class::Accessor/;
14 __PACKAGE__->mk_accessors(qw(session_uuid session_path));
15
16
17 =head1 NAME
18
19 Session - save or load emulator interactive session
20
21 =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
31
32 =head2 record_session
33
34 $self->record_session( 'name', $value );
35
36 =cut
37
38 my $last_tick = 0;
39
40 my $t = 0;
41 my @timeline;
42 my $s;
43
44 sub record_session {
45 my $self = shift;
46 my $name = shift || confess "need name";
47 my $value = shift || confess "need value";
48
49 my $path = $self->session_path;
50
51 if ( ! $path ) {
52 $path = 'sess/current';
53 $self->session_path( $path );
54 if ( -e $path ) {
55 warn "session appending to: $path\n";
56 } else {
57 warn "session creating: $path\n";
58 }
59 }
60
61 if ( @timeline ) {
62 warn "INFO: Aborting recorderd session\n";
63 @timeline = ();
64 $t = 0;
65 $s = {};
66 $last_tick = 0;
67 }
68
69 my $t = $self->app->ticks;
70 my $dt = $t - $last_tick;
71 $last_tick = $t;
72
73 if ( ! $self->session_uuid ) {
74 my $uuid = strftime('%Y-%m-%d %H:%M:%S',localtime);
75 $self->append_to_file($path, "# $uuid\n");
76 $self->session_uuid( $uuid );
77 }
78
79 $self->append_to_file($path, 'event(', dump( $dt, $name, $value ),");\n");
80
81 }
82
83 sub event {
84 my $dt = shift || croak 'expected dt';
85 my $name = shift || croak 'expected name';
86 my $value = shift || croak 'expected value';
87
88 $t += $dt;
89 push @timeline, $t;
90 $s->{$t}->{$name} = $value;
91
92 # warn "## created event($dt,$name,",dump($value),")\n";
93 }
94
95 =head2 load_session
96
97 $self->load_session( '/path/to/session.pl' );
98
99 =cut
100
101 sub load_session {
102 my $self = shift;
103 my $path = shift || confess "no path?";
104
105 if ( ! -r $path ) {
106 warn "WARNING: can't open session $path: $!\n";
107 return;
108 }
109
110 eval read_file( $path );
111 warn "session = ",dump( $s ) if $self->can('debug') && $self->debug;
112
113 my ( $from, $to ) = @timeline[0,-1];
114 printf "loaded session %.2f-%.2fs with %d events\n", $from / 1000, $to / 1000, $#timeline + 1;
115 }
116
117 =head2 session_event
118
119 my $v = $self->session_event('key_pressed');
120
121 =cut
122
123 sub session_event {
124 my $self = shift;
125
126 return unless @timeline;
127
128 my $name = shift || confess "no name?";
129
130 my $t = $self->app->ticks;
131
132 # do we have events to trigger?
133 return if ( $t < $timeline[0] );
134
135 my $e_t = $timeline[0];
136
137 # do we have next event and should we take it?
138 if ( $#timeline > 0 && $t > $timeline[1] ) {
139 shift @timeline;
140 $e_t = $timeline[0];
141 warn "session_event $e_t $name ",dump( $s->{$e_t}->{$name} )," left ", $#timeline+1, " events\n";
142 }
143
144 return $s->{$e_t}->{$name};
145 }
146
147 =head1 SEE ALSO
148
149 L<VRac>
150
151 =cut
152
153 1;

  ViewVC Help
Powered by ViewVC 1.1.26