Add libwx-perl

[pkg-perl] / deb-src / libwx-perl / libwx-perl-0.96 / blib / lib / Wx / Overload / Driver.pm

diff --git a/deb-src/libwx-perl/libwx-perl-0.96/blib/lib/Wx/Overload/Driver.pm b/deb-src/libwx-perl/libwx-perl-0.96/blib/lib/Wx/Overload/Driver.pm
new file mode 100644 (file)
index 0000000..9734edf
--- /dev/null
+++ b/deb-src/libwx-perl/libwx-perl-0.96/blib/lib/Wx/Overload/Driver.pm
@@ -0,0 +1,209 @@
+#############################################################################
+## Name:        build/Wx/Overload/Driver.pm
+## Purpose:     builds overload constants
+## Author:      Mattia Barbon
+## Modified by:
+## Created:     17/08/2001
+## RCS-ID:      $Id: Driver.pm 2500 2008-11-05 22:17:53Z mbarbon $
+## Copyright:   (c) 2001-2003, 2005-2008 Mattia Barbon
+## Licence:     This program is free software; you can redistribute it and/or
+##              modify it under the same terms as Perl itself
+#############################################################################
+
+package Wx::Overload::Driver;
+
+use strict;
+
+use Symbol qw(gensym);
+
+use Wx::Overload::Handle;
+
+my %_name2type =
+  (
+   wimg => 'Wx::Image',
+   wbmp => 'Wx::Bitmap',
+   wico => 'Wx::Icon',
+   wmen => 'Wx::Menu',
+   wmit => 'Wx::MenuItem',
+   wrec => 'Wx::Rect',
+   wreg => 'Wx::Region',
+   wszr => 'Wx::Sizer',
+   wtip => 'Wx::ToolTip',
+   wwin => 'Wx::Window',
+   wcol => 'Wx::Colour',
+   wlci => 'Wx::ListItem',
+   wgco => 'Wx::GridCellCoords',
+   wdat => 'Wx::DataObject',
+   wcur => 'Wx::Cursor',
+   wehd => 'Wx::EvtHandler',
+   wfon => 'Wx::Font',
+   wdc  => 'Wx::DC',
+   wfrm => 'Wx::Frame',
+   wsiz => 1,
+   wpoi => 1,
+   wist => 1,
+   wost => 1,
+   num  => 1,
+   str  => 1,
+   bool => 1,
+   arr  => 1,
+   wpos => 1,
+   zzz  => 1,
+   );
+
+my %name2type = %_name2type;
+my %constants;
+
+sub new {
+  my( $class, %args ) = @_;
+  my $self = bless \%args, $class;
+
+  return $self;
+}
+
+sub process {
+  my( $self ) = @_;
+
+  $self->_parse;
+  $self->_write;
+}
+
+sub _parse {
+  my( $self ) = @_;
+
+  foreach my $i ( $self->files ) {
+    my %namedecl = %_name2type;
+    open my $fh, '<', $i or die "open '$i': $!";
+
+    while( <$fh> ) {
+      if( m/DECLARE_OVERLOAD\(\s*(\w+)\s*,\s*(\S+)\s*\)/ ) {
+        $namedecl{$1} = $2;
+        next if exists $name2type{$1} && $name2type{$1} eq $2;
+        die "Clashing type: '$1' was '$name2type{$1}', redeclared as '$2'"
+          if exists $name2type{$1};
+        $name2type{$1} = $2;
+      }
+      if( m/Wx::_match\(\s*\@_\s*,\s*\$Wx::_(\w+)\s*\,/ ||
+          m/wxPliOvl_(\w+)/ ) {
+        my $const = $1;
+        my @const = split /_/, $const;
+        foreach my $j ( @const ) {
+          $j = 'num' if $j eq 'n';
+          $j = 'str' if $j eq 's';
+          $j = 'bool' if $j eq 'b';
+
+          die "unrecognized type '$j' in file '$i'"
+            unless $namedecl{$j};
+          $constants{$const} = \@const;
+        }
+      }
+    }
+  }
+}
+
+sub _write {
+  my( $self ) = @_;
+
+  my @keys = ( ( sort grep { $name2type{$_} eq '1' } keys %name2type ),
+               ( sort grep { $name2type{$_} ne '1' } keys %name2type ) );
+
+  my $vars_comma = join ", ",
+                   map  "\$$_",
+                        @keys;
+  my $vars = $vars_comma; $vars =~ s/,//g;
+  my $types = join ", ",
+              map  "'$name2type{$_}'",
+              grep $name2type{$_} ne '1',
+                   @keys;
+  my $cpp_types = $types; $cpp_types =~ s/\'/\"/g;
+
+  # header
+  {
+    my $out = gensym;
+    tie *$out, 'Wx::Overload::Handle', $self->header;
+
+    my $enum = join ",\n",
+               map  "    wxPliOvl$_",
+                    @keys;
+
+    print $out <<EOT;
+// GENERATED FILE, DO NOT EDIT
+
+#ifndef _CPP_OVERLOAD_H
+#define _CPP_OVERLOAD_H
+
+enum
+{
+    wxPliOvl\_Dummy = 0,
+$enum
+};
+
+#endif
+
+EOT
+
+    foreach my $i ( sort keys %constants ) {
+      print $out "extern const wxPliPrototype wxPliOvl_${i};\n";
+    }
+
+    close $out;
+  }
+
+  # write source
+  {
+    my $out = gensym;
+    tie *$out, 'Wx::Overload::Handle', $self->source;
+
+    print $out <<EOT;
+// GENERATED FILE, DO NOT EDIT
+
+const char* wxPliOvl\_tnames[] = { 0,
+$cpp_types
+};
+
+extern void wxPli_set_ovl_constant( const char* name,
+                                    const wxPliPrototype* value );
+EOT
+
+    print $out <<EOT;
+
+#ifndef WXPL_EXT
+
+void SetOvlConstants()
+{
+    dTHX;
+EOT
+
+    foreach my $i ( sort keys %constants ) {
+      print $out <<EOT
+    wxPli_set_ovl_constant( \"$i\", &wxPliOvl_${i} );
+EOT
+    }
+
+    print $out <<EOT;
+}
+
+#endif // WXPL_EXT
+
+EOT
+
+    foreach my $i ( sort keys %constants ) {
+      my $count = scalar @{$constants{$i}};
+      print $out "const unsigned char wxPliOvl_${i}_datadef\[\] = { ";
+      print $out join ", ", map { "wxPliOvl$_" } @{$constants{$i}};
+      print $out " };\n";
+      print $out <<EOT;
+const wxPliPrototype wxPliOvl_${i}
+    ( wxPliOvl\_tnames, wxPliOvl_${i}_datadef, $count );
+EOT
+    }
+
+    close $out;
+  }
+}
+
+sub source { $_[0]->{source} }
+sub header { $_[0]->{header} }
+sub files  { @{$_[0]->{files}} }
+
+1;