Changeset 9355
- Timestamp:
- 11/30/09 22:16:31 (9 months ago)
- Location:
- trunk/Padre-Plugin-wxGlade
- Files:
-
- 4 modified
-
Makefile.PL (modified) (1 diff)
-
lib/Padre/Plugin/wxGlade/WXG.pm (modified) (2 diffs)
-
t/03_wxg.t (modified) (3 diffs)
-
t/sample/Dialogs.pl (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
trunk/Padre-Plugin-wxGlade/Makefile.PL
r9353 r9355 2 2 3 3 all_from lib/Padre/Plugin/wxGlade.pm 4 requires Padre 0.45 5 requires XML::Tiny 1.11 6 test_requires Test::More 0.82 4 requires File::Slurp 9999.12 5 requires Padre 0.45 6 requires Params::Util 1.00 7 requires XML::Tiny 1.11 8 test_requires Test::More 0.82 -
trunk/Padre-Plugin-wxGlade/lib/Padre/Plugin/wxGlade/WXG.pm
r9353 r9355 3 3 use strict; 4 4 use warnings; 5 use Params::Util qw{ _STRING _HASH }; 5 6 # use XML::Tiny (); 6 7 7 8 our $VERSION = '0.01'; 9 10 11 12 13 14 ###################################################################### 15 # Constructor and Accessors 8 16 9 17 sub new { … … 15 23 my $document = XML::Tiny::parsefile( $file ); 16 24 17 # Extract application properties 18 my $application = $document->[0]; 25 # Validate the file 26 unless ( _HASH($document->[0]) and $document->[0]->{name} eq 'application' ) { 27 die("Invalid or unsupported wxGlade XML"); 28 } 19 29 20 30 # Create the WXG object 21 my $self = bless { }, $class; 31 my $self = $document->[0]; 32 bless $self, $class; 33 34 # Save the path to the wxg file 35 $self->{wxg} = $file; 22 36 23 37 return $self; 24 38 } 25 39 40 sub wxg { 41 $_[0]->{wxg}; 42 } 43 44 sub language { 45 $_[0]->{attrib}->{language}; 46 } 47 48 sub for_version { 49 $_[0]->{attrib}->{for_version}; 50 } 51 52 sub path { 53 $_[0]->{attrib}->{path}; 54 } 55 56 # Smarter equivalent for path 57 sub file { 58 my $self = shift; 59 60 # Handle null cases 61 unless ( defined _STRING($self->path) ) { 62 return $self->path; 63 } 64 65 # Handle the trivial positive case 66 if ( -f $self->path ) { 67 return $self->path; 68 } 69 70 # Because wxGlade saves absolute paths, they don't transport well. 71 # If the literal path doesn't exist, add support for the generated 72 # file being in the same directory as the WXG file itself. 73 die( "CODE INCOMPLETE" ); 74 } 75 76 # Valid usable top level objects 77 sub objects { 78 grep { 79 $_->{type} eq 'e' 80 and 81 $_->{name} eq 'object' 82 and 83 $_->{attrib}->{name} 84 and 85 $_->{attrib}->{class} 86 } @{$_[0]->{content}}; 87 } 88 89 # The list of top level window names in the application 90 sub windows { 91 grep { 92 defined _STRING($_) 93 } map { 94 $_->{attrib}->{name} 95 } $_[0]->objects 96 } 97 98 # Fetch a window tag 99 sub window { 100 my $self = shift; 101 my $name = shift; 102 foreach ( $self->objects ) { 103 next unless $_->{attrib}->{name} eq $name; 104 return $_; 105 } 106 return; 107 } 108 109 # Fetch the top window 110 sub top_window { 111 my $self = shift; 112 $self->window( $self->{attrib}->{top_window} ); 113 } 114 115 116 117 118 119 ###################################################################### 120 # Main Methods 121 122 sub supported { 123 my $self = shift; 124 unless ( $self->language and $self->language eq 'perl' ) { 125 die("The wxGlade application is not targetting Perl"); 126 } 127 unless ( $self->for_version and $self->for_version eq '2.8' ) { 128 die("The wxGlade application is not build for wxGlade 2.8"); 129 } 130 my $path = $self->path; 131 unless ( $path and -f $path ) { 132 die("The wxGlade output path '$path' does not exist"); 133 } 134 return 1; 135 } 136 137 # Loads the Perl code for a single named window 138 sub extract { 139 my $self = shift; 140 my $window = shift; 141 142 # Load the Perl file and localize newlines 143 my $file = $self->file; 144 my $perl = _lslurp($file); 145 146 # Extract the class from the overall file 147 my $package = $window->{attrib}->{class}; 148 my @code = $$perl =~ /\n(package $package;.+?# end of class $package\n+1;\n)/sg; 149 unless ( @code ) { 150 die("Failed to find package '$package' in file '$file'"); 151 } 152 unless ( @code == 1 ) { 153 die("Found more than one package '$package' in file '$file'"); 154 } 155 156 return $code[0]; 157 } 158 159 # Provide a simple _slurp implementation (copied from PPI::Util) 160 # Avoids a 1 meg File::Slurp load. 161 sub _lslurp { 162 my $file = shift; 163 local $/ = undef; 164 local *FILE; 165 open( FILE, '<', $file ) or die("open($file) failed: $!"); 166 my $source = <FILE>; 167 close( FILE ) or die("close($file) failed: $!"); 168 $source =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; 169 return \$source; 170 } 171 26 172 1; -
trunk/Padre-Plugin-wxGlade/t/03_wxg.t
r9354 r9355 6 6 use strict; 7 7 use warnings; 8 use Test::More 0.82 tests => 2;8 use Test::More 0.82 tests => 19; 9 9 use File::Spec::Functions ':ALL'; 10 10 use Padre::Plugin::wxGlade::WXG (); … … 12 12 my $SAMPLE = catfile( 't', 'sample', 'Dialogs.wxg' ); 13 13 ok( -f $SAMPLE, 'Sample wxg file exists' ); 14 15 my @WINDOWS = qw{ 16 frame_1 17 dialog_find 18 dialog_replace 19 dialog_openurl 20 dialog_warning 21 }; 14 22 15 23 … … 25 33 ); 26 34 35 # Accessor tests 36 is( $wxg->wxg, $SAMPLE, '->file ok' ); 37 is( $wxg->language, 'perl', '->language ok' ); 38 is( $wxg->for_version, '2.8', '->for_version ok' ); 39 is( $wxg->path, 'F:\padre\wxglade\Dialogs.pl', '->path ok' ); 40 41 # Get the list of windows 42 my @windows = $wxg->windows; 43 is_deeply( 44 \@windows, 45 \@WINDOWS, 46 'Found expected windows', 47 ); 48 49 # Load a named window 50 is( ref($wxg->window('dialog_warning')), 'HASH', 'Found dialog_warning' ); 51 is( ref($wxg->top_window), 'HASH', 'Found ->top_window' ); 52 53 # Extract the Perl class for each 54 foreach my $name ( @WINDOWS ) { 55 my $code = $wxg->extract( $wxg->window($name) ); 56 ok( defined $code, 'Found code for $name' ); 57 ok( length($code), 'Found code for $name' ); 58 } 59 27 60 1; -
trunk/Padre-Plugin-wxGlade/t/sample/Dialogs.pl
r9352 r9355 5 5 use Wx 0.15 qw[:allclasses]; 6 6 use strict; 7 8 package MyDialog4; 9 10 use Wx qw[:everything]; 11 use base qw(Wx::Dialog); 12 use strict; 13 14 sub new { 15 my( $self, $parent, $id, $title, $pos, $size, $style, $name ) = @_; 16 $parent = undef unless defined $parent; 17 $id = -1 unless defined $id; 18 $title = "" unless defined $title; 19 $pos = wxDefaultPosition unless defined $pos; 20 $size = wxDefaultSize unless defined $size; 21 $name = "" unless defined $name; 22 23 # begin wxGlade: MyDialog4::new 24 25 $style = wxDEFAULT_DIALOG_STYLE 26 unless defined $style; 27 28 $self = $self->SUPER::new( $parent, $id, $title, $pos, $size, $style, $name ); 29 $self->{warning_label} = Wx::StaticText->new($self, -1, "See http://padre.perlide.org/ for update information", wxDefaultPosition, wxDefaultSize, wxALIGN_CENTRE); 30 $self->{warning_checkbox} = Wx::CheckBox->new($self, -1, "Do not show this again", wxDefaultPosition, wxDefaultSize, ); 31 $self->{line_1} = Wx::StaticLine->new($self, -1, wxDefaultPosition, wxDefaultSize, ); 32 $self->{ok_button} = Wx::Button->new($self, wxID_OK, ""); 33 34 $self->__set_properties(); 35 $self->__do_layout(); 36 37 # end wxGlade 38 return $self; 39 40 } 41 42 43 sub __set_properties { 44 my $self = shift; 45 46 # begin wxGlade: MyDialog4::__set_properties 47 48 $self->SetTitle("Warning"); 49 50 # end wxGlade 51 } 52 53 sub __do_layout { 54 my $self = shift; 55 56 # begin wxGlade: MyDialog4::__do_layout 57 58 $self->{sizer_4} = Wx::BoxSizer->new(wxHORIZONTAL); 59 $self->{sizer_5} = Wx::BoxSizer->new(wxVERTICAL); 60 $self->{sizer_6} = Wx::BoxSizer->new(wxHORIZONTAL); 61 $self->{sizer_5}->Add($self->{warning_label}, 0, 0, 0); 62 $self->{sizer_5}->Add($self->{warning_checkbox}, 0, wxTOP|wxEXPAND, 5); 63 $self->{sizer_5}->Add($self->{line_1}, 0, wxTOP|wxBOTTOM|wxEXPAND, 5); 64 $self->{sizer_6}->Add($self->{ok_button}, 0, 0, 0); 65 $self->{sizer_5}->Add($self->{sizer_6}, 1, wxALIGN_CENTER_HORIZONTAL, 5); 66 $self->{sizer_4}->Add($self->{sizer_5}, 1, wxALL|wxEXPAND, 5); 67 $self->SetSizer($self->{sizer_4}); 68 $self->{sizer_4}->Fit($self); 69 $self->Layout(); 70 71 # end wxGlade 72 } 73 74 # end of class MyDialog4 75 76 1; 7 77 8 78 package MyFrame;
