/[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 159 by dpavlin, Sun Aug 5 18:25:53 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));
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 $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 {  sub record_session {
47          my $self = shift;          my $self = shift;
48          my $name = shift || confess "need name";          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;          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          $self->append_to_file('session.pl', "\$s->{$t}->{'$name'} = ", dump( @_ ),";\n");  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  =head2 load_session
# Line 43  sub record_session { Line 87  sub record_session {
87    
88  =cut  =cut
89    
 my $s;  
 my @timeline;  
   
90  sub load_session {  sub load_session {
91          my $self = shift;          my $self = shift;
92          my $path = shift || confess "no path?";          my $path = shift || confess "no path?";
# Line 58  sub load_session { Line 99  sub load_session {
99          eval read_file( $path );          eval read_file( $path );
100          warn "session = ",dump( $s );          warn "session = ",dump( $s );
101    
         @timeline = sort { $a <=> $b } keys %$s;  
   
102          my ( $from, $to ) = @timeline[0,-1];          my ( $from, $to ) = @timeline[0,-1];
103          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;
104  }  }
Legend:
Removed from v.150  
changed lines
  Added in v.159
  ViewVC Help
Powered by ViewVC 1.1.26