/[Frey]/trunk/lib/Frey/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 /trunk/lib/Frey/Session.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 824 by dpavlin, Fri Dec 12 23:20:06 2008 UTC revision 1159 by dpavlin, Thu Jul 2 15:31:41 2009 UTC
# Line 1  Line 1 
1  package Frey::Session;  package Frey::Session;
2  use Moose::Role;  use Moose::Role;
3    
4  with 'Frey::Path';  with 'Frey::Path', 'Frey::Storage';
5    
 __PACKAGE__->mkbasepath( 'var/session/something.db' );  
   
 use DBM::Deep;  
6  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
7  use Time::HiRes qw/time/;  use Time::HiRes qw/time/;
8  use Carp qw/carp croak/;  use Carp qw/carp croak/;
9    
 our $usage = DBM::Deep->new( 'var/session/usage.db' );  
10  has 'usage' => (  has 'usage' => (
11          documentation => 'Track usage of classes for ClassBrowser',          documentation => 'Track usage of classes for ClassBrowser',
12          is => 'rw',          is => 'rw',
13          isa => 'DBM::Deep',          isa => 'HashRef|Undef',
         lazy => 1,  
         default => sub {  
                 $usage  
         },  
 );  
   
 our $bugs = DBM::Deep->new( 'var/session/bugs.db' );  
 has 'bugs' => (  
         documentation => 'Track bugs within Frey',  
         is => 'rw',  
         isa => 'DBM::Deep',  
14          lazy => 1,          lazy => 1,
15          default => sub {          default => sub {
16                  $bugs                  my $self = shift;
17                    $self->load( 'var/session/usage.yaml' ) || {};
18          },          },
19  );  );
20    
21  =for debug  our $bugs;
22    
23  sub session_as_data {  sub add_usage {
24          my ($self) = @_;          my ( $self, $class ) = @_;
25          {          $self->usage->{$class}++;
26                  usage => $self->session_dump( $self->usage ),          $self->store( 'var/session/usage.yaml', $self->usage );
27                  bugs => $self->session_dump( $self->bugs ),          # FIXME triggering bugs savings just once on each request, but is cludge!
28          }          $self->store( 'var/session/bugs.yaml', $bugs ) if delete $bugs->{save};
 }  
   
 =cut  
   
 sub session_dump {  
         my ($self,$db) = @_;  
         my $data;  
   
         my $key = $db->first_key();  
     while ($key) {  
                 $data->{$key} = $db->get($key);  
                 $key = $db->next_key($key);  
         }  
   
         return $data;  
29  }  }
30    
31  =head2 TODO  =head2 TODO
# Line 66  sub session_dump { Line 37  sub session_dump {
37  sub TODO {  sub TODO {
38          my ( $self, $what ) = @_;          my ( $self, $what ) = @_;
39          eval {          eval {
40                  $self->bugs = {} unless defined $self->bugs; # bootstrap                  $bugs ||= $self->load( 'var/session/bugs.yaml' );
41                  carp "TODO: $what" unless defined $self->bugs->{TODO}->{ $what };  
42                    carp "TODO: $what" unless defined $bugs->{TODO}->{ $what };
43    
44                  my ( $package, $path, $line ) = caller;                  my ( $package, $path, $line ) = caller;
45    
46                  $self->bugs->{TODO}->{ $what } = {                  $bugs->{TODO}->{ $what } = {
47                          last_occured => time,                          last_occured => time,
48                          'package' => $package,                          'package' => $package,
49                          path => $path,                          path => $path,
50                          line => $line,                          line => $line,
51                  }                  };
52                    $bugs->{save}++;
53          };          };
54          warn "TODO ERROR: $@\n$what" if $@;          warn "TODO ERROR: $@\n$what" if $@;
55          return $what;          return $what;
56  }  }
57    
58    
59    no Moose::Role;
60    
61  1;  1;
Legend:
Removed from v.824  
changed lines
  Added in v.1159
  ViewVC Help
Powered by ViewVC 1.1.26