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));


=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 $path = 'session.pl';

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";

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

        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	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));
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 $path = 'session.pl';
39
40	my $last_tick = 0;
41
42	my $t = 0;
43	my @timeline;
44	my $s;
45
46	sub record_session {
47	my $self = shift;
48	my $name = shift \|\| confess "need name";
49	my $value = shift \|\| confess "need value";
50
51	if ( @timeline ) {
52	warn "INFO: Aborting recorderd session\n";
53	@timeline = ();
54	$t = 0;
55	$s = {};
56	}
57
58	my $t = $self->app->ticks;
59	my $dt = $t - $last_tick;
60	$last_tick = $t;
61
62	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
68	$self->append_to_file($path, 'event(', dump( $dt, $name, $value ),");\n");
69
70	}
71
72	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	=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	if ( ! -r $path ) {
95	warn "WARNING: can't open session $path: $!\n";
96	return;
97	}
98
99	eval read_file( $path );
100	warn "session = ",dump( $s );
101
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	=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	=head1 SEE ALSO
137
138	L<VRac>
139
140	=cut
141
142	1;