[Catalyst-commits] r6655 - in
trunk/Catalyst-Engine-Wx/lib/Catalyst: . Log
eriam at dev.catalyst.perl.org
eriam at dev.catalyst.perl.org
Mon Aug 13 12:44:37 GMT 2007
Author: eriam
Date: 2007-08-13 12:44:36 +0100 (Mon, 13 Aug 2007)
New Revision: 6655
Added:
trunk/Catalyst-Engine-Wx/lib/Catalyst/Log/
trunk/Catalyst-Engine-Wx/lib/Catalyst/Log/Wx.pm
Log:
Added a frame for debugging purpose
Added: trunk/Catalyst-Engine-Wx/lib/Catalyst/Log/Wx.pm
===================================================================
--- trunk/Catalyst-Engine-Wx/lib/Catalyst/Log/Wx.pm (rev 0)
+++ trunk/Catalyst-Engine-Wx/lib/Catalyst/Log/Wx.pm 2007-08-13 11:44:36 UTC (rev 6655)
@@ -0,0 +1,153 @@
+package Catalyst::Log::Wx;
+
+use strict;
+use base 'Class::Accessor::Fast';
+use Data::Dump;
+use Wx qw[:everything];
+
+our $VERSION = "0.01_01";
+
+use Catalyst::Engine::Wx::Event qw(
+ EVT
+);
+
+our %LEVELS = ();
+
+__PACKAGE__->mk_accessors('level');
+__PACKAGE__->mk_accessors('body');
+__PACKAGE__->mk_accessors('abort');
+__PACKAGE__->mk_accessors('frame');
+
+{
+ my @levels = qw[ debug info warn error fatal ];
+
+ for ( my $i = 0 ; $i < @levels ; $i++ ) {
+
+ my $name = $levels[$i];
+ my $level = 1 << $i;
+
+ $LEVELS{$name} = $level;
+
+ no strict 'refs';
+
+ *{$name} = sub {
+ my $self = shift;
+
+ if ( $self->{level} & $level ) {
+ $self->_log( $name, @_ );
+ }
+ };
+
+ *{"is_$name"} = sub {
+ my $self = shift;
+ return $self->{level} & $level;
+ };
+ }
+}
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new;
+ $self->levels( scalar(@_) ? @_ : keys %LEVELS );
+
+ $self->frame(Wx::Frame->new( undef, -1, 'Catalyst::Log::Wx', wxDefaultPosition, [600,400], wxDEFAULT_FRAME_STYLE ));
+ $self->frame->{reloader} = Wx::TextCtrl->new($self->frame, -1, "", wxDefaultPosition, wxDefaultSize, );
+ $self->frame->{logger} = Wx::TextCtrl->new($self->frame, -1, "", wxDefaultPosition, wxDefaultSize, wxTE_MULTILINE|wxTE_READONLY);
+
+ my $log = Wx::LogTextCtrl->new( $self->frame->{logger} );
+ $self->frame->{old_log} = Wx::Log::SetActiveTarget( $log );
+
+ $self->frame->{sizer_2} = Wx::BoxSizer->new(wxVERTICAL);
+ $self->frame->{sizer_2}->Add($self->frame->{reloader}, 0, wxEXPAND, 0);
+ $self->frame->{sizer_2}->Add($self->frame->{logger}, 4, wxEXPAND, 0);
+ $self->frame->SetSizer($self->frame->{sizer_2});
+ $self->frame->{sizer_2}->Fit($self->frame);
+ $self->frame->Layout();
+
+ Wx::Event::EVT_TEXT_ENTER($self->frame, $self->frame->{reloader}->GetId, \&_reload);
+
+ $self->frame->SetSize(Wx::Size->new(600, 400));
+ $self->frame->{logger}->SetFont(Wx::Font->new(8, wxMODERN, wxNORMAL, wxNORMAL, 0, ""));
+
+ $self->frame->Show(1);
+
+ return $self;
+}
+
+sub levels {
+ my ( $self, @levels ) = @_;
+ $self->level(0);
+ $self->enable(@levels);
+}
+
+sub enable {
+ my ( $self, @levels ) = @_;
+ $self->{level} |= $_ for map { $LEVELS{$_} } @levels;
+}
+
+sub disable {
+ my ( $self, @levels ) = @_;
+ $self->{level} &= ~$_ for map { $LEVELS{$_} } @levels;
+}
+
+sub _dump {
+ my $self = shift;
+ $self->info( Data::Dump::dump(@_) );
+}
+
+sub _log {
+ my $self = shift;
+ my $level = shift;
+ my $message = join( "\n", @_ );
+ chomp($message);
+
+ $self->frame->{logger}->WriteText($message."\n");
+}
+
+sub _reload {
+ my ($self, $event) = @_;
+
+ EVT($self, $self->{reloader}->GetValue);
+
+ $event->Skip;
+}
+1;
+
+__END__
+
+=head1 NAME
+
+Catalyst::Log::Wx - Catalyst Log Class for Wx engine
+
+=head1 SYNOPSIS
+
+
+ use Catalyst::Log::Wx;
+
+ MyApp->log(Catalyst::Log::Wx->new);
+
+
+See L<Catalyst>.
+
+=head1 DESCRIPTION
+
+This module provides a debug frame for the Wx catalyst engine.
+
+From the debug frame you can also fire events.
+
+=head1 SEE ALSO
+
+L<Catalyst>.
+
+=head1 AUTHOR
+
+Eriam Schaffter, C<eriam at cpan.org>
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
Property changes on: trunk/Catalyst-Engine-Wx/lib/Catalyst/Log/Wx.pm
___________________________________________________________________
Name: svn:keywords
+ "Id Date Revision Author LastChangedDate LastChangedRevision URL HeadURL"
Name: svn:eol-style
+ native
More information about the Catalyst-commits
mailing list