/[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 170 by dpavlin, Mon Aug 6 09:20:49 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 session_path));
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 $last_tick = 0;  my $last_tick = 0;
39    
40    my $t = 0;
41    my @timeline;
42    my $s;
43    
44  sub record_session {  sub record_session {
45          my $self = shift;          my $self = shift;
46          my $name = shift || confess "no name?";          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;          my $t = $self->app->ticks;
70          my $dt = $t - $last_tick;          my $dt = $t - $last_tick;
71          $last_tick = $t;          $last_tick = $t;
72    
73          $self->append_to_file('session.pl', "\$s->{$t}->{$name} = ", dump( @_ ),";\n");          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  =head2 load_session
# Line 51  sub load_session { Line 102  sub load_session {
102          my $self = shift;          my $self = shift;
103          my $path = shift || confess "no path?";          my $path = shift || confess "no path?";
104    
105          my $s;          if ( ! -r $path ) {
106          eval read_file( $path );                  warn "WARNING: can't open session $path: $!\n";
107          warn "s = ",dump( $s );                  return;
108            }
109    
110          my @timeline = sort { $a <=> $b } keys %$s;          eval read_file( $path );
111            warn "session = ",dump( $s );
112    
113          my ( $from, $to ) = @timeline[0,-1];          my ( $from, $to ) = @timeline[0,-1];
114          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;
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  =head1 SEE ALSO
148    
149  L<VRac>  L<VRac>
Legend:
Removed from v.145  
changed lines
  Added in v.170
  ViewVC Help
Powered by ViewVC 1.1.26