/[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 1142 by dpavlin, Tue Jun 30 15:10:55 2009 UTC revision 1143 by dpavlin, Wed Jul 1 17:03:49 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  sub add_usage {
22            my ( $self, $class ) = @_;
23  sub session_as_data {          $self->usage->{$class}++;
24          my ($self) = @_;          $self->store( 'var/session/usage.yaml', $self->usage );
         {  
                 usage => $self->session_dump( $self->usage ),  
                 bugs => $self->session_dump( $self->bugs ),  
         }  
 }  
   
 =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;  
25  }  }
26    
27  =head2 TODO  =head2 TODO
# Line 63  sub session_dump { Line 30  sub session_dump {
30    
31  =cut  =cut
32    
33    our $bugs;
34    
35  sub TODO {  sub TODO {
36          my ( $self, $what ) = @_;          my ( $self, $what ) = @_;
37          eval {          eval {
38                  $self->bugs = {} unless defined $self->bugs; # bootstrap                  $bugs ||= $self->load( 'var/session/bugs.yaml' );
39                  carp "TODO: $what" unless defined $self->bugs->{TODO}->{ $what };  
40                    carp "TODO: $what" unless defined $bugs->{TODO}->{ $what };
41    
42                  my ( $package, $path, $line ) = caller;                  my ( $package, $path, $line ) = caller;
43    
44                  $self->bugs->{TODO}->{ $what } = {                  $bugs->{TODO}->{ $what } = {
45                          last_occured => time,                          last_occured => time,
46                          'package' => $package,                          'package' => $package,
47                          path => $path,                          path => $path,
# Line 79  sub TODO { Line 49  sub TODO {
49                  }                  }
50          };          };
51          warn "TODO ERROR: $@\n$what" if $@;          warn "TODO ERROR: $@\n$what" if $@;
52            $self->store( 'var/session/bugs.yaml', $bugs );
53          return $what;          return $what;
54  }  }
55    
Legend:
Removed from v.1142  
changed lines
  Added in v.1143
  ViewVC Help
Powered by ViewVC 1.1.26