viewvc.cgi/VRac/Session.pm

package Session;

# Dobrica Pavlinusic, <dpavlin@rot13.org> 08/05/07 14:27:15 CEST

use strict;
use warnings;

use Carp qw/confess croak/;
use Data::Dump qw/dump/;
use File::Slurp;
use POSIX qw/strftime/;

use base qw/Class::Accessor/;
__PACKAGE__->mk_accessors(qw(session_uuid session_path));


=head1 NAME

Session - save or load emulator interactive session

=head1 DESCRIPTION

Sessions are simple perl programs using one function C<event>

  event( $ticks_wait, 'name', $hash );

Using this, you can refactor your sessions or use perl constructs around
them.

=head1 FUNCTIONS

=head2 record_session

  $self->record_session( 'name', $value );

=cut

my $last_tick = 0;

my $t = 0;
my @timeline;
my $s;

sub record_session {
        my $self = shift;
        my $name = shift || confess "need name";
        my $value = shift || confess "need value";

        my $path = $self->session_path;

        if ( ! $path ) {
                $path = 'sess/current';
                $self->session_path( $path );
                if ( -e $path ) {
                        warn "session appending to: $path\n";
                } else {
                        warn "session creating: $path\n";
                }
        }

        if ( @timeline ) {
                warn "INFO: Aborting recorderd session\n";
                @timeline = ();
                $t = 0;
                $s = {};
                $last_tick = 0;
        }

        my $t = $self->app->ticks;
        my $dt = $t - $last_tick;
        $last_tick = $t;

        if ( ! $self->session_uuid ) {
                my $uuid = strftime('%Y-%m-%d %H:%M:%S',localtime);
                $self->append_to_file($path, "# $uuid\n");
                $self->session_uuid( $uuid );
        }

        $self->append_to_file($path, 'event(', dump( $dt, $name, $value ),");\n");

}

sub event {
        my $dt = shift || croak 'expected dt';
        my $name = shift || croak 'expected name';
        my $value = shift || croak 'expected value';

        $t += $dt;
        push @timeline, $t;
        $s->{$t}->{$name} = $value;

        warn "## created event($dt,$name,",dump($value),")\n";
}

=head2 load_session

  $self->load_session( '/path/to/session.pl' );

=cut

sub load_session {
        my $self = shift;
        my $path = shift || confess "no path?";

        if ( ! -r $path ) {
                warn "WARNING: can't open session $path: $!\n";
                return;
        }

        eval read_file( $path );
        warn "session = ",dump( $s );

        my ( $from, $to ) = @timeline[0,-1];
        printf "loaded session %.2f-%.2fs with %d events\n", $from / 1000, $to / 1000, $#timeline + 1;
}

=head2 session_event

  my $v = $self->session_event('key_pressed');

=cut

sub session_event {
        my $self = shift;

        return unless @timeline;

        my $name = shift || confess "no name?";

        my $t = $self->app->ticks;

        # do we have events to trigger?
        return if ( $t < $timeline[0] );

        my $e_t = $timeline[0];

        # do we have next event and should we take it?
        if ( $#timeline > 0 && $t > $timeline[1] ) {
                shift @timeline;
                $e_t = $timeline[0];
                warn "session_event $e_t $name ",dump( $s->{$e_t}->{$name} )," left ", $#timeline+1, " events\n";
        }

        return $s->{$e_t}->{$name};
}

=head1 SEE ALSO

L<VRac>

=cut

1;
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			warn "## created event($dt,$name,",dump($value),")\n";
93			}
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	150	warn "session = ",dump( $s );
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;