/[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 150 by dpavlin, Sun Aug 5 15:16:10 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    
# Line 27  Session - save or load emulator interact Line 35  Session - save or load emulator interact
35    
36  =cut  =cut
37    
38    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 "need 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;
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('session.pl', "\$s->{$t}->{'$name'} = ", dump( @_ ),";\n");          $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
96    
97    $self->load_session( '/path/to/session.pl' );    $self->load_session( '/path/to/session.pl' );
98    
99  =cut  =cut
100    
 my $s;  
 my @timeline;  
   
101  sub load_session {  sub load_session {
102          my $self = shift;          my $self = shift;
103          my $path = shift || confess "no path?";          my $path = shift || confess "no path?";
# Line 58  sub load_session { Line 110  sub load_session {
110          eval read_file( $path );          eval read_file( $path );
111          warn "session = ",dump( $s );          warn "session = ",dump( $s );
112    
         @timeline = sort { $a <=> $b } keys %$s;  
   
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  }  }

Legend:
Removed from v.150  
changed lines
  Added in v.170

  ViewVC Help
Powered by ViewVC 1.1.26