/[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 562 by dpavlin, Thu Nov 27 21:04:35 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/;
8    use Carp qw/carp croak/;
9    
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',
14          lazy => 1,          lazy => 1,
15          default => sub {          default => sub {
16                  DBM::Deep->new( 'var/session/usage.db' );                  my $self = shift;
17                    $self->load( 'var/session/usage.yaml' ) || {};
18          },          },
19  );  );
20    
21  has 'bugs' => (  our $bugs;
22          documentation => 'Track bugs within Frey',  
23          is => 'rw',  sub add_usage {
24          isa => 'DBM::Deep',          my ( $self, $class ) = @_;
25          lazy => 1,          $self->usage->{$class}++;
26          default => sub {          $self->store( 'var/session/usage.yaml', $self->usage );
27                  DBM::Deep->new( 'var/session/bugs.db' );          # FIXME triggering bugs savings just once on each request, but is cludge!
28          },          $self->store( 'var/session/bugs.yaml', $bugs ) if delete $bugs->{save};
 );  
 sub as_data {  
         my ($self) = @_;  
         {  
                 usage => $self->session_dump( $self->usage ),  
                 bugs => $self->session_dump( $self->bugs ),  
         }  
29  }  }
30    
31  sub session_dump {  =head2 TODO
         my ($self,$db) = @_;  
         my $data;  
   
         my $key = $db->first_key();  
     while ($key) {  
                 $data->{$key} = $db->get($key);  
                 $key = $db->next_key($key);  
         }  
32    
33          return $data;    my $TODO = $self->TODO( "message" );
 }  
34    
35    =cut
36    
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                  warn "TODO: $what" unless defined $self->bugs->{TODO}->{ $what };  
42                  $self->bugs->{TODO}->{ $what }->{ time() } = {                  carp "TODO: $what" unless defined $bugs->{TODO}->{ $what };
43                          backtrace => caller,  
44                  }                  my ( $package, $path, $line ) = caller;
45    
46                    $bugs->{TODO}->{ $what } = {
47                            last_occured => time,
48                            'package' => $package,
49                            path => $path,
50                            line => $line,
51                    };
52                    $bugs->{save}++;
53          };          };
54          warn "TODO ERROR: $@\n$what" if $@;          warn "TODO ERROR: $@\n$what" if $@;
55            return $what;
56  }  }
57    
58    
59    no Moose::Role;
60    
61  1;  1;
Legend:
Removed from v.562  
changed lines
  Added in v.1159
  ViewVC Help
Powered by ViewVC 1.1.26