/[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 186 - (hide annotations)
Sun Sep 30 19:50:30 2007 UTC (11 years, 6 months ago) by dpavlin
File size: 2843 byte(s)
hush debugging output
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 170 __PACKAGE__->mk_accessors(qw(session_uuid session_path));
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 $last_tick = 0;
39    
40     my $t = 0;
41     my @timeline;
42     my $s;
43    
44 dpavlin 145 sub record_session {
45     my $self = shift;
46 dpavlin 150 my $name = shift || confess "need name";
47 dpavlin 159 my $value = shift || confess "need value";
48 dpavlin 145
49 dpavlin 170 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 dpavlin 159 if ( @timeline ) {
62     warn "INFO: Aborting recorderd session\n";
63     @timeline = ();
64     $t = 0;
65     $s = {};
66 dpavlin 170 $last_tick = 0;
67 dpavlin 159 }
68    
69 dpavlin 145 my $t = $self->app->ticks;
70 dpavlin 159 my $dt = $t - $last_tick;
71     $last_tick = $t;
72 dpavlin 145
73 dpavlin 159 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 dpavlin 145
79 dpavlin 159 $self->append_to_file($path, 'event(', dump( $dt, $name, $value ),");\n");
80    
81 dpavlin 145 }
82    
83 dpavlin 159 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 dpavlin 186 # warn "## created event($dt,$name,",dump($value),")\n";
93 dpavlin 159 }
94    
95 dpavlin 145 =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 dpavlin 150 if ( ! -r $path ) {
106     warn "WARNING: can't open session $path: $!\n";
107     return;
108     }
109    
110 dpavlin 145 eval read_file( $path );
111 dpavlin 186 warn "session = ",dump( $s ) if $self->debug;
112 dpavlin 145
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 dpavlin 150 =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 dpavlin 145 =head1 SEE ALSO
148    
149     L<VRac>
150    
151     =cut
152    
153     1;

  ViewVC Help
Powered by ViewVC 1.1.26