Alien-wxWidgets-0.69000775000000000000 013075252613 15020 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/Build.PL000775000000000000 2754213075252274 16513 0ustar00unknownunknown000000000000#!/usr/bin/perl -w BEGIN { our $NO_INIT = 1 } use strict; use lib "./lib", "./inc"; use My::Build; use Config; our( $TYPE, $URL, $FORCE_GTX ); my %VERSIONS = ( '2.8.12' => 'patches/data-2.8.12', '2.8.11' => 'patches/data-2.8.11', '2.8.10' => 'patches/data-2.8.10', '2.9.0' => 'patches/data-2.9.0', '2.9.1' => 'patches/data-2.9.1', '2.9.2' => 'patches/data-2.9.2', '2.9.3' => 'patches/data-2.9.3', '2.9.4' => 'patches/data-2.9.4', '3.0.0' => 'patches/data-3.0.0', '3.0.1' => 'patches/data-3.0.1', '3.0.2' => 'patches/data-3.0.2', ); my ($DEFAULT_VERSION, $DEFAULT_ARCHIVE_TYPE) = _get_default_wxwidgets_version_and_type(); if( $^O eq 'cygwin' ) { print <subclass... my $class = Module::Build->subclass ( class => 'My::Build::new_from_context_is_broken', code => <<'EOC' ); use lib qw(lib inc); @ISA = qw(My::Build Module::Build); require My::Build; EOC my $build = $class->new ( module_name => 'Alien::wxWidgets', license => 'perl', author => 'Mattia Barbon ', requires => { perl => '5.006', 'Module::Pluggable' => '2.6', }, build_requires => { 'Module::Build' => '0.28', 'ExtUtils::CBuilder' => '0.24', 'File::Spec' => '1.50', 'LWP::Protocol::https' => '0', }, configure_requires => { 'Module::Build' => '0.28', }, get_options => { 'wxWidgets-debug' => { type => '!' }, 'wxWidgets-unicode' => { type => '!' }, 'wxWidgets-mslu' => { type => '!' }, 'wxWidgets-static' => { type => '!' }, 'wxWidgets-monolithic' => { type => '!' }, 'wxWidgets-universal' => { type => '!' }, 'wxWidgets-build' => { type => '!' }, 'wxWidgets-portable' => { type => '!', default => $^O eq 'MSWin32' }, 'wxWidgets-build-opengl' => { type => '!' }, 'wxWidgets-source' => { type => '=s' }, 'wxWidgets-version' => { type => '=s' }, 'wxWidgets-extraflags' => { type => '=s' }, 'wxWidgets-userpatch' => { type => '=s' }, 'wxWidgets-graphicscontext' => { type => '!', default => 1 }, }, create_makefile_pl => 'passthrough', meta_merge => { resources => { 'license' => [ 'http://dev.perl.org/licenses/' ], 'homepage' => 'http://www.wxperl.it/', 'bugtracker' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Alien-wxWidgets', 'repository' => 'http://svn.code.sf.net/p/wxperl/code/Alien-wxWidgets', 'MailingList' => 'http://lists.perl.org/list/wxperl-users.html', }, }, ); my $accept_defaults = $ENV{PERL5_CPANPLUS_IS_RUNNING} || $ENV{CPAN_SHELL_LEVEL}; my $build_wx_dflt = 'yes'; my $build_wx_opengl_dflt = 'yes'; my $build_prompt = 'Do you want to fetch and build wxWidgets from sources?'; my $have_alien_configuration = 0; # try to detect if wxWidgets has been installed using Alien::wxWidgets and if # it is the latest version; the rule is: # # if there is any any wxWidgets installation registered with Alien::wxWidgets # it will only get upgraded if it was compiled using Alien::wxWidgets itself and # it is older than $DEFAULT_VERSION my $ok = eval { require Alien::wxWidgets; require File::Basename; require File::Spec; require Cwd; $DEFAULT_VERSION =~ m/^(\d+)\.(\d+)\.(\d+)$/ or die "Wrong default version"; my $install_version = $1 + $2 / 1000 + $3 / 1000000; my @configs = Alien::wxWidgets->get_configurations; $build_wx_dflt = 'no' if @configs; $have_alien_configuration = @configs; foreach my $config ( @configs ) { last if $config->{version} >= $install_version; # installed version is older than $DEFAULT_VERSION, check if it # has been installed using Alien::wxWidgets my %values = $config->{package}->values; ( my $pm_filename = $config->{package} . '.pm' ) =~ s{::}{/}g; my $pm_file = $INC{$pm_filename}; my $pm_path = File::Spec->catdir( File::Basename::dirname( $pm_file ), File::Spec->updir ); my $prefix = File::Spec->catdir( $values{prefix}, File::Spec->updir ); if( Cwd::realpath( $pm_path ) eq Cwd::realpath( $prefix ) ) { $build_wx_dflt = 'yes'; } } 1; }; # if anything went wrong in the autodetection, revert to the correct # default if( !$ok ) { $build_wx_dflt = 'yes'; } # detect wxWidgets using WXDIR/WXWIN environment variables on Win32 # and wx-config on other platforms if( $^O eq 'MSWin32' && ( $ENV{WXWIN} || $ENV{WXDIR} ) ) { $build_wx_dflt = 'no'; $build_prompt = sprintf <awx_path_search( 'wx-config' ); if( $wx_config ) { my $ans = `$wx_config --version`; if( $ans =~ /^[23]\./ ) { my $prefix = `$wx_config --prefix`; chomp foreach $ans, $prefix; if( _check_installed_widgets_ok($ans, $prefix) ) { $build_wx_dflt = 'no' ; $build_prompt = sprintf <&1`; unless( $ans =~ /^[23]\./ ) { print <notes( 'build_wx' => $build_wx ); $build->notes( 'mk_portable' => $build->args('wxWidgets-portable') ); $build->notes( 'install_only' => $have_alien_configuration && !$build_wx && $accept_defaults ); $build->notes( 'extraflags' => $build->args('wxWidgets-extraflags') || '' ); $build->notes( 'userpatch' => $build->args('wxWidgets-userpatch') || '' ); $build->notes( 'graphicscontext' => $build->args('wxWidgets-graphicscontext') ); if( $build_wx ) { $wx_version = _askmulti( $build, 'wxWidgets-version', 'Which wxWidgets version?', [ sort keys %VERSIONS ], $DEFAULT_VERSION ); $DEFAULT_ARCHIVE_TYPE = 'tar.bz2' if $wx_version =~ /^(2\.9|3\.)/; # no tar.gz at sourceforge site $TYPE = _ask( $build, 'wxWidgets-source', 'Which archive type?', $DEFAULT_ARCHIVE_TYPE ); $URL = $ENV{AWX_URL}; $FORCE_GTX = $build->args('wxWidgets-graphicscontext'); $build->notes( 'build_data' => do $VERSIONS{$wx_version} ); } if( $build_wx && $wx_version !~ /^(2\.9|3\.)/ ) { my $build_wx_unicode = _askyn( $build, 'wxWidgets-unicode', 'Do you want to enable Unicode support', 'yes' ); $build->notes( 'build_wx_unicode' => $build_wx_unicode ); } elsif( $build_wx ) { # Unicode-only for 2.9.x and higher $build->notes( 'build_wx_unicode' => 1 ); } if( $build_wx ) { my $build_wx_opengl = _askyn( $build, 'wxWidgets-build-opengl', 'Do you want to include OpenGL support', $build_wx_opengl_dflt ); $build->notes( 'build_wx_opengl' => $build_wx_opengl ); } $build->create_build_script; sub _is_yes { return lc( $_[0] ) eq 'y' || lc( $_[0] ) eq 'yes' || $_[0] eq 1; } sub _askyn { my( $build, $arg, $question, $default ) = @_; my $res = defined $build->args( $arg ) ? _is_yes( $build->args( $arg ) ) : exists $ENV{"AWX_\U$arg"} ? _is_yes( $ENV{"AWX_\U$arg"} ) : $accept_defaults ? _is_yes( $default ) : $build->y_n( $question, $default ); return $res } sub _askmulti { my( $build, $arg, $question, $options, $default ) = @_; $question .= " (" . join( ', ', @$options ) . ")"; my $res = defined $build->args( $arg ) ? $build->args( $arg ) : exists $ENV{"AWX_\U$arg"} ? $ENV{"AWX_\U$arg"} : $accept_defaults ? $default : $build->prompt( $question, $default ); die "Invalid value '$res' for option '$arg': must be one of ", join( ', ', map "'$_'", @$options ), "\n" unless grep $_ eq $res, @$options; return $res } sub _ask { my( $build, $arg, $question, $default ) = @_; my $res = defined $build->args( $arg ) ? $build->args( $arg ) : exists $ENV{"AWX_\U$arg"} ? $ENV{"AWX_\U$arg"} : $accept_defaults ? $default : $build->prompt( $question, $default ); return $res } sub _get_default_wxwidgets_version_and_type { # default version and archive type my $defver = '3.0.2'; my $deftype = 'tar.bz2'; if( $^O =~ /^linux/i) { # 2.8.10 if this is gtk < 2.4 my $pkg_config = $ENV{PKG_CONFIG} || 'pkg-config'; if( my $gtkfullver = qx($pkg_config --modversion gtk+-2.0 2>&1) ) { if($gtkfullver =~ /^\d+\.(\d+)\.\d+/) { if ( $1 < 4 ) { $defver = '2.8.10'; $deftype = 'tar.gz'; } } } } return ($defver, $deftype); } sub _check_installed_widgets_ok { my($wxversion, $wxprefix) = @_; return 1 if $^O !~ /^darwin/i; # catch current common case of system installed # widgets 2.8.x on a 64 bit capable Mac + 64 bit # perl # assume installed 2.9.x is osx-cocoa 64 bit if( $Config{ptrsize} == 8 && $wxversion =~ /^2\.8\./ ) { return 0; } else { return 1; } } 1; Alien-wxWidgets-0.69/Changes000664000000000000 2672513075252473 16512 0ustar00unknownunknown000000000000Revision history for Perl extension Alien::wxWidgets. 0.69 Tue Apr 18 2017 - added build dependency on LWP::Protocol::https - it is always - necessary due to sourceforge redirect to https 0.68 Sat Apr 8 2017 - RT:120887 - patch from Jim Keenan for '.' no longer in@INC - RT:94367 - allow ENV setting for wx-config - Fix current OSX builds 0.67 Tue Mar 10 2015 - pause indexing fix 0.66 Tue Mar 10 2015 - add support for wxWidgets 3.0.1 and 3.0.2 - make default wxWidgets 3.0.2 - graphics context included now default on Win32 - build on MacOSX - xcode 5.x/6.x 0.65 Mon Mar 31 2014 - Update default to wxWidgets 3.0.0 - build on MacOSX Mavericks with Xcode 4.6.3 - install builtins on wxMSW (used by some wxWidgets extensions) 0.64 Sat Apr 13 2013 - Build IPC on Windows 0.63 Fri Oct 26 2012 - Patches for wxGTK build fixing dir dialog issues 0.62 Tue Oct 2 2012 - Fix patching on MSWin when buildpaths have spaces. - Allow addition of user patch - --wxWidgets-userpatch - Expand README.txt - Another Mac OS X SDK change 0.61 Fri Sep 21 2012 - change default debug level for wxWidgets >= 2.9 to 1 ( was 0) - fix several incorrect wxWidgets version checks 0.60 Fri Aug 24 2012 - allow building 2.9.4 - correct SDKs for Mountain Lion - fixes for XCode 4.4 0.59 Tue May 01 2012 - Version sub modules to keep meta info users happy 0.58 Thu Apr 12 2012 - WXWIN / WXDIR MSWin32 fix. 0.57 Tue Mar 27 2012 - fix for osx-cocoa overlay drawing in 2.9.x - Return --with-osx_cocoa . --with-mac on better basis. - several fixes for default macosx builds 0.56 Fri Mar 16 2012 - add propgrid ribbon webview library names 0.55 Tue Feb 28 2012 - Correctly interpret boolean option = 1 as 'yes' ( Thanks to Robert Olsen ) - Fix for msw builds where Perl defines -D_USE_32BIT_TIME_T ( Thanks to Bjoern Hoehrmann ) - Fix for Xcode 4.3 on OSX Lion - Allow build 2.9.3 wxWidgets (default for 64 bit Mac) 0.54 Wed Nov 09 08:00:00 BST 2011 - Remove force of static binding for mingw libgcc & libstdc++ - For mingw, properly detect the gcc shared lib dependencies to install 0.53 Thu Oct 13 08:00:00 BST 2011 - SDK fix for 2.8.x on Mac OSX Lion - 2.9.2 default for 64bit MacOSX - 2.9.2 build changes for msw supporting mingw/gcc >= 4.5.2 - 2003 Platform SDK build fixed for 2.8.12 0.52 Thu May 05 08:00:00 BST 2011 - release 0.51_01 as 0.52 0.51_01 Thu Apr 21 22:28:51 BST 2011 - 64 bit mingw printing fix - 2.9.1 default for 64bit MacOSX - 2.8.12 general default 0.51 Tue Mar 30 22:28:51 CEST 2010 - Build fix for Perl 5.12. 0.50_02 Sun Mar 21 10:33:00 CET 2010 - Fixed 64 bit compilation when using the MinGW-w64 compiler. 0.50_01 Fri Feb 26 17:08:21 CET 2010 - Added wxWidgets-extraflags build option. - Exit with an error message under Cygwin. - Use the system version of Archive::Extract and File::Fetch if newer than the bundled version. 0.50 Sun Jan 10 16:16:44 CET 2010 - When compiling on Windows with MSVC 9, make the generated wxWidgets DLL load correctly by adding a manifest to them (suggested by IKEGAMI). - Add a missing file to the distribution. 0.49 Sat Jan 9 10:39:02 CET 2010 - Support GCC 4 and 64 bit GCC builds on Windows (patch by KMX). - Fix monolithic build handling for wxWidgets' 2.8.x. 0.48 Fri Dec 25 18:23:56 CET 2009 - Fix the compiler check for Visual C++. 0.47 Sat Dec 5 16:16:05 CET 2009 - Released 0.46_01 as 0.47. 0.46_01 Tue Nov 24 20:34:25 CET 2009 - Do not give a warning when installed using WiX (patch by Curtis Jewell). - Tentative patch to correctly detect wxWidgets under OpenBSD, based on RT ticket 41678. - Under Solaris, use GNU Make to build wxWidgets, and fail if it is not present or can't be detected. - Detect wxWidgets versions that have been installed using Alien::wxWidgets itself and avoid needlessly recompiling/reinstalling it. 0.46 Sun Nov 8 16:25:02 CET 2009 - Allow choosing the wxWidgets version to build (defaults to the latest stable release when building from the CPAN shell). - Add a build configuration for wxWidgets 2.9.0. - On Snow Leopard, build wxCocoa when building wxWidgets 2.9.0 with a 64 bit Perl. - On Windows, enable the 'portable' option by default (finds the wxWidgets libraries relative to the Alien::wxWidgets installation directory). 0.45 Wed Oct 14 22:54:35 CEST 2009 - On Snow Leopard, abort wxWidgets build if Perl is 64 bit. - On Snow Leopard, force wxWidgets build to be 32 bit. 0.44 Sun Aug 9 12:56:05 CEST 2009 - Rename all command line options to avoid clashing with Module::Build options. 0.43 Sun May 10 09:46:05 CEST 2009 - Fix building under recent FreeBSD versions (patch by Cezary Morga). - Correctly handle monolithic build on wxWidgets' 2.9.x. - Support Cocoa builds for wxWidgets 2.9.x. - Fix building wxWidgets when the build path contains spaces. - Patch and build wxWidgets 2.8.10. 0.42 Sat Nov 8 00:51:18 CET 2008 - Add an option for building with Unicode support in interactive configuration (defaults to yes). - Use ExtUtils::CBuilder to try to detect non-working (or non-installed) compilers. 0.41 Mon Oct 27 22:22:25 CET 2008 - Rewrite show_configurations to display a pretty-printed version of the available wxWidgets builds. - When load() fails to find a compatible configuration, display a the selection criteria and a list of available configurations. 0.40 Wed Oct 15 20:23:15 CEST 2008 - Always use Archive::Extract to extract the wxWidgets archive since it now handles .bz2 files correctly on all platforms. - Add a manifest to the bundled patch.exe to avoid triggering an UAC prompt under Windows Vista. 0.39 Mon Sep 8 20:56:44 CEST 2008 - Add missing file to MANIFEST. 0.38 Sun Aug 24 11:17:37 CEST 2008 - Patch and build wxWidgets 2.8.8. - When running with AUTOMATED_TESTING try to detect GTK+2 presence and abort early if it can't be found. 0.37 Sun Jun 29 21:40:16 CEST 2008 - Always use binary programs to extract archives, unless under Win32. 0.36 Mon May 19 22:35:46 CEST 2008 - Renamed 0.35_01 to 0.36. 0.35_01 Mon May 12 23:43:02 CEST 2008 - Handle --install_base correctly when building wxWidgets during Alien::wxWidgets build. 0.35 Thu May 1 16:25:04 CEST 2008 - Correctly handle monolithic build on Win32. (patch by Mark Dootson) - Add mk_portable (Win32-only) build option to create a self-contained wxWidgets+Alien::wxWidgets installation even when not building wxWidgets together with Alien::wxWidgets. (patch by Mark Dootson) 0.34 Sun Apr 13 12:40:08 CEST 2008 - Correctly detect GCC 4.3. (patch by Roberto C. Sánchez) 0.33 Sat Jan 19 17:35:57 CET 2008 - Patch and build wxWidgets 2.8.7. 0.32 Thu Aug 16 00:11:40 CEST 2007 - Patch and build wxWidgets 2.8.4. - Correctly handle flags for wxWidgets Universal Mac builds. - Allow building a monolithic wxWidgets. - Allow building Mac Universal binaries for wxWidgets. - Updated bundled Archive::Extract to the latest version. 0.31 Sat Mar 24 17:25:25 CET 2007 - Patch and build wxWidgets 2.8.3. - Automatically link in C++ runtime for MSVC 7.0 and above. 0.30 Sun Mar 18 16:47:23 CET 2007 - Fetch and build wxWidgets 2.8.2. 0.29 Fri Mar 16 20:11:31 CET 2007 - Must require Perl 5.006, not 5.6. 0.28 Sat Mar 10 21:41:32 CET 2007 - Release 0.27_51 as the new stable version. 0.27_51 Sun Feb 25 22:54:07 CET 2007 - Fetch and build wxWidgets 2.8.1. 0.27_50 Sun Feb 25 22:39:43 CET 2007 - Fetch and build wxWidgets 2.8.0. - Update bundled modules to the latest version. 0.27 Tue Dec 19 23:04:41 CET 2006 - Support monolithic wxWidgets builds. 0.26 Sat Dec 16 19:42:57 CET 2006 - Improve error reporting for missing libraries. 0.25 Sun Nov 5 18:39:22 CET 2006 - Add aui and richtest to the wxWidgets libraries searched with wx-config. 0.24 Fri Oct 20 21:27:57 CEST 2006 - Add an option for disabling OpenGL support when building wxWidgets. 0.23 Thu Oct 19 21:41:16 CEST 2006 - Use a smart default for the "Do you want to build wxWidgets?" question. 0.22 Tue Oct 3 20:30:48 CEST 2006 - Fixed a bug in detecting an installed wxWidgets in /usr/lib64 in x86_64 systems. (patch by Jose Pedro Oliveira) - When fetching wxWidgets, print the download URL. 0.21 Sun Aug 27 17:17:56 CEST 2006 - Check that the build environment is sane under Win32. 0.20 Tue Aug 15 17:45:12 CEST 2006 - Bundle and use the patch implementation from GNU under Windows; the PPT implementation is way too fragile. 0.19 Sun Jul 16 15:46:11 CEST 2006 - Fixes for when the compiler user for building is not in the PATH when installing. 0.18 Sun Jul 9 12:31:44 CEST 2006 - Restored compatibility with wxWidgets 2.4 where it uses configure/wx-config. 0.17 Fri Jul 7 22:14:13 CEST 2006 - Do not test POD for bundled libraries. 0.16 Wed Jul 5 21:58:33 CEST 2006 - Fixed extraction error when using Archive::Extract. 0.15 Wed Jul 5 20:26:32 CEST 2006 - Bundled missing Archive::Extract. 0.14 Sun Jun 25 13:00:37 CEST 2006 - Make the wxWidgets archive type configurable when building wxWidgets, defaulting to .tar.gz instead of .tar.bz2. 0.13 Sun Jun 18 17:52:44 CEST 2006 - Removed (unused) Module::Install from inc. 0.12 Mon Jun 5 21:59:58 CEST 2006 - Work with old versions of Test::Pod. - Added a 'passthrough' Makefile.PL. - Take GCC ABI compatibility into account when comparing compiler versions. - Clearly signal that we need bzip2 to extract wxWidgets. 0.11 Thu May 25 22:27:05 CEST 2006 - Bundle and use the patch implementation from PPT. - Rediffed all the patches against wxWidgets 2.6.3. 0.10 Sun May 21 19:19:39 CEST 2006 - Prefer $CXX to $CC if both are set. - Download and build wxWidgets 2.6.3. 0.09 Tue May 2 21:27:03 CEST 2006 - Use mingw32-make as an alternative to make under Win32/MinGW. 0.08 Sun Apr 30 12:33:01 CEST 2006 - Fix the build process with CPANPLUS. 0.07 Mon Apr 24 23:16:30 CEST 2006 - Fix the download URL for wxWidgets 2.6.2. - Fix the build process under Windows. 0.06 Sun Apr 23 14:35:47 CEST 2006 - Cache the absolute path of the wx-config used, and always use it during the build even if PATH changes. 0.05 Fri Apr 21 22:40:38 CEST 2006 - Work around a Module::Build handling of @INC when building from CPAN. 0.04 Sun Apr 16 17:01:07 CEST 2006 - Optionally build wxWidgets from sources. - Allow some actions (like 'dist') to be executed without an installed wxWidgets. - Detect when some wxWidgets contrib libraries are not built on wx-config platforms. - Check for a recent 'nmake' for Win32+MSVC+Bakefile. 0.03 Wed Aug 17 20:57:49 CEST 2005 - Allow multiple configurations to be installed at the same time. 0.02 Wed Aug 17 00:53:40 CEST 2005 - Added support for wxWidgets 2.4.x. - Fixed option handling. - Small corrections to the existing code. - Added documentation. 0.01 Tue Aug 16 00:00:12 CEST 2005 - First release. Only supports detecting an already-installed wxWidgets. Works for wxWidgets 2.5.x/2.6.x under Mac OS X, Windows, Linux (and probably other Unices). Alien-wxWidgets-0.69/MANIFEST000664000000000000 600213072201176 16301 0ustar00unknownunknown000000000000Build.PL Changes inc/bin/patch inc/bin/patch.exe inc/inc_Archive-Extract/Archive/Extract.pm inc/inc_File-Fetch/File/Fetch.pm inc/inc_IPC-Cmd/IPC/Cmd.pm inc/inc_Locale-Maketext-Simple/Locale/Maketext/Simple.pm inc/inc_Module-Load-Conditional/Module/Load/Conditional.pm inc/inc_Module-Load/Module/Load.pm inc/inc_Params-Check/Params/Check.pm inc/inc_version/version.pm inc/inc_version/version/vpp.pm inc/latest.pm inc/latest/private.pm inc/My/Build.pm inc/My/Build/Any_wx_config.pm inc/My/Build/Any_wx_config_Bakefile.pm inc/My/Build/Base.pm inc/My/Build/gmake.mak inc/My/Build/MacOSX_wx_config.pm inc/My/Build/nmake.mak inc/My/Build/Utility.pm inc/My/Build/Win32.pm inc/My/Build/Win32_MinGW.pm inc/My/Build/Win32_MinGW_Bakefile.pm inc/My/Build/Win32_MSVC.pm inc/My/Build/Win32_MSVC_Bakefile.pm inc/src/patch-2.5.9-7-src.zip inc/src/patch.exe.manifest lib/Alien/wxWidgets.pm lib/Alien/wxWidgets/Utility.pm Makefile.PL MANIFEST META.yml patches/cocoaoverlay-2-9-3.patch patches/data-2.8.10 patches/data-2.8.11 patches/data-2.8.12 patches/data-2.9.0 patches/data-2.9.1 patches/data-2.9.2 patches/data-2.9.3 patches/data-2.9.4 patches/data-3.0.0 patches/data-3.0.1 patches/data-3.0.2 patches/wxGTK-2.8.12-dirdialog.patch patches/wxGTK-2.9.4-dirdialog.patch patches/wxMac-2.8.10-fontdlg.patch patches/wxMac-2.8.3-brokengcc.patch patches/wxMac-2.9.0-textctrl.patch patches/wxMSW-2.8.0-config.patch patches/wxMSW-2.8.0-makefiles.patch patches/wxMSW-2.8.0-setup.patch patches/wxMSW-2.8.0-setup_u.patch patches/wxMSW-2.8.10-config.patch patches/wxMSW-2.8.10-makefiles.patch patches/wxMSW-2.8.10-version.patch patches/wxMSW-2.8.10-w64-mslu.patch patches/wxMSW-2.8.10-w64-stc.patch patches/wxMSW-2.8.10-w64-winhash.patch patches/wxMSW-2.8.10-w64.patch patches/wxMSW-2.8.11-filefn.patch patches/wxMSW-2.8.11-makefiles.patch patches/wxMSW-2.8.11-w64.patch patches/wxMSW-2.8.12-w64-stc.patch patches/wxMSW-2.8.12-w64.patch patches/wxMSW-2.8.4-config.patch patches/wxMSW-2.9.0-config.patch patches/wxMSW-2.9.0-makefiles.patch patches/wxMSW-2.9.0-setup.patch patches/wxMSW-2.9.0-version.patch patches/wxMSW-2.9.0-w64-filefn.patch patches/wxMSW-2.9.1-makefiles.patch patches/wxMSW-2.9.1-setup.patch patches/wxMSW-2.9.1-w64-mslu.patch patches/wxMSW-2.9.2-makefiles.patch patches/wxMSW-2.9.2-setup.patch patches/wxMSW-2.9.2-setup_gctx.patch patches/wxMSW-2.9.3-makefiles.patch patches/wxMSW-2.9.3-setup.patch patches/wxMSW-2.9.3-setup_gctx.patch patches/wxMSW-2.9.4-makefiles.patch patches/wxMSW-2.9.4-setup.patch patches/wxMSW-2.9.4-setup_gctx.patch patches/wxMSW-3.0.0-makefiles.patch patches/wxMSW-3.0.1-defs.patch patches/wxMSW-3.0.1-setup.patch patches/wxMSW-3.0.1-setup_gctx.patch patches/wxWidgets-2.8.0-magic.patch patches/wxWidgets-2.8.10-gsocket.patch patches/wxWidgets-2.9.0-magic.patch patches/wxWidgets-2.9.0-msgdlg.patch patches/wxWidgets-2.9.4-plugin.patch patches/wxWidgets-3.0.2-webkit.patch README.txt script/make_ppm.pl t/01_load.t t/zy_pod_coverage.t t/zz_pod.t META.json Alien-wxWidgets-0.69/META.json000664000000000000 330213075252612 16575 0ustar00unknownunknown000000000000{ "abstract" : "building, finding and using wxWidgets binaries", "author" : [ "Mattia Barbon " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4222", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Alien-wxWidgets", "prereqs" : { "build" : { "requires" : { "ExtUtils::CBuilder" : "0.24", "File::Spec" : "1.50", "LWP::Protocol::https" : "0", "Module::Build" : "0.28" } }, "configure" : { "requires" : { "Module::Build" : "0.28" } }, "runtime" : { "requires" : { "Module::Pluggable" : "2.6", "perl" : "5.006" } } }, "provides" : { "Alien::wxWidgets" : { "file" : "lib/Alien/wxWidgets.pm", "version" : "0.69" }, "Alien::wxWidgets::Utility" : { "file" : "lib/Alien/wxWidgets/Utility.pm", "version" : "0.59" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "http://rt.cpan.org/NoAuth/Bugs.html?Dist=Alien-wxWidgets" }, "homepage" : "http://www.wxperl.it/", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "http://svn.code.sf.net/p/wxperl/code/Alien-wxWidgets" }, "x_MailingList" : "http://lists.perl.org/list/wxperl-users.html" }, "version" : "0.69", "x_serialization_backend" : "JSON::PP version 2.27300_01" } Alien-wxWidgets-0.69/META.yml000664000000000000 214213075252612 16426 0ustar00unknownunknown000000000000--- abstract: 'building, finding and using wxWidgets binaries' author: - 'Mattia Barbon ' build_requires: ExtUtils::CBuilder: '0.24' File::Spec: '1.50' LWP::Protocol::https: '0' Module::Build: '0.28' configure_requires: Module::Build: '0.28' dynamic_config: 1 generated_by: 'Module::Build version 0.4222, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Alien-wxWidgets provides: Alien::wxWidgets: file: lib/Alien/wxWidgets.pm version: '0.69' Alien::wxWidgets::Utility: file: lib/Alien/wxWidgets/Utility.pm version: '0.59' requires: Module::Pluggable: '2.6' perl: '5.006' resources: MailingList: http://lists.perl.org/list/wxperl-users.html bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Alien-wxWidgets homepage: http://www.wxperl.it/ license: http://dev.perl.org/licenses/ repository: http://svn.code.sf.net/p/wxperl/code/Alien-wxWidgets version: '0.69' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Alien-wxWidgets-0.69/Makefile.PL000664000000000000 245213075252612 17133 0ustar00unknownunknown000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4222 require 5.006; unless (eval "use Module::Build::Compat 0.02; 1" ) { print "This module requires Module::Build to install itself.\n"; require ExtUtils::MakeMaker; my $yn = ExtUtils::MakeMaker::prompt (' Install Module::Build now from CPAN?', 'y'); unless ($yn =~ /^y/i) { die " *** Cannot install without Module::Build. Exiting ...\n"; } require Cwd; require File::Spec; require CPAN; # Save this 'cause CPAN will chdir all over the place. my $cwd = Cwd::cwd(); CPAN::Shell->install('Module::Build::Compat'); CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate or die "Couldn't install Module::Build, giving up.\n"; chdir $cwd or die "Cannot chdir() back to $cwd: $!"; } eval "use Module::Build::Compat 0.02; 1" or die $@; use lib '_build/lib'; Module::Build::Compat->run_build_pl(args => \@ARGV); my $build_script = 'Build'; $build_script .= '.com' if $^O eq 'VMS'; exit(0) unless(-e $build_script); # cpantesters convention require My::Build::new_from_context_is_broken; Module::Build::Compat->write_makefile(build_class => 'My::Build::new_from_context_is_broken'); Alien-wxWidgets-0.69/README.txt000664000000000000 1263012306621540 16672 0ustar00unknownunknown000000000000=head1 NAME README.txt - build and installation instructions =head1 DESCRIPTION Alien::wxWidgets allows wxPerl to easily find information about your wxWidgets installation. It can store this information for multiple wxWidgets versions or configurations (debug, Unicode, etc.). It can also build and install a private copy of wxWidgets as part of the build process. =head1 Installing wxWidgets If you do not know how to do it, please answer 'yes' to the question 'Do you want to build wxWidgets?'; Alien::wxWidgets will build and install a copy of wxWidgets for you. =head1 Installing Alien::wxWidgets Please note that the steps below can be repeated multiple times in order install multiple configurations (differing for the wxWidgets version, compiler, compiler version, debug/unicode settings). =head2 Unices and Mac OS X Important: If you are going to use the system wxWidgets or your own build of wxWidgets then either your required wx-config must be the first wx-config in the PATH or the WX_CONFIG environment variable must be set to the full path to wx-config. The environment WX_CONFIG variable can also be used to specify a different wx-config. perl Build.PL perl Build perl Build test perl Build install =head3 Requirements for building on Unices If you are going to ask Alien::wxWidgets to build wxWidgets you will need to install development prerequisites. The following is the list for Ubuntu but you can adapt for your own distribution where the package names may vary. gcc g++ libgtk2.0-dev libgstreamer0.10-dev libgstreamer-plugins-base0.10-dev libglu1-mesa-dev libexpat1-dev libtiff4-dev libpng12-dev libjpeg-dev libcairo2-dev freeglut3-dev libxmu-dev libwebkitgtk-dev* To build the wxWebView componenent you need libwebkitgtk version 1.3.1 or greater. For Linux distributions currently this means a fairly recent release. For example, Ubuntu ge 11.10 If you do not have a recent enough libwebkitgtk installed then configure will simply not build the library. This is harmless. =head2 Windows If you are going to build your own wxWidgets then set WXDIR=C:\Path\to\wxWidgets Then whether you have built your own wxWidgets or not: perl Build.PL perl Build perl Build test perl Build install Important: If you do not allow Alien to build wxWidgets, the command line options to Build.PL must match the build settings used to build wxWidgets. =head2 Command Line Options for build perl Build.PL --wxWidgets-graphicscontext For wxWidgets 2.8.x this flag will cause wxGraphicsContext to be built and used. On Windows, your compiler must support GDI+. For wxWidgets 2.9.x, the build system detects whether wxGraphicsContext is supported. However, the default for any flavour of MinGW or MSVC 6 is to assume that wxGraphicsContext is NOT supported. So if you know that wxGraphicsContext IS supported, you can use this flag to force inclusion. perl Build.PL --wxWidgets-unicode=1 Only relevant for wxWidgets 2.8.x, indicate if you want a unicode build. --wxWidgets-unicode=1|0, default is 1 perl Build.PL --wxWidgets-build=0 Indicate if you want wxWidgets to be downloaded and built --wxWidgets-build=1|0, default depends on whether Aline-wxWidgets finds a usable wxWidgets installation on your system. An explict value always overrides the default. Always use an explicit flag if you want to avoid prompts. perl Build.PL --wxWidgets-version=2.8.12 If --wxWidgets-build=1, indicate the version of wxWidgets to build. e.g. --wxWidgets-version=2.9.4. The current default is 2.8.12. Always use an explicit flag if you want to avoid prompts. perl Build.PL --wxWidgets-source=tar.gz If --wxWidgets-build=1, indicate the type of archive to download e.g. --wxWidgets-source=tar.bz2, then default for wxWidgets 2.8.x is tar.gz and the default for wxWidgets 2.9.x is tar.bz2. Always use an explicit flag if you want to avoid prompts. perl Build.PL --wxWidgets-build-opengl=1 Build the wxGLCanvas libraries. --wxWidgets-build-opengl=1|0 default is 1. Always use an explicit flag if you want to avoid prompts. perl Build.PL --wxWidgets-extraflags="--disable-compat26" On Unices and Mac OS X you may use this to pass through any flags you may wish to configure. Doing so however will drop any additional default flags that Alien wxWidgets would normally pass to configure to ensure that wxWidgets builds as required on your system. This approach is used so that you can use this to configure precisely to your requirement and not have Alien-wxWidgets override it. e.g. --wxWidgets-extraflags="CC=gcc-4.0 --with-expat=builtin --disable-compat28" On Windows this option can be used to pass options directly to mingw32-make or nmake. You can usefully pass any of the options in build/msw/config.(vc|gcc) e.g. --wxWidgets-extraflags="USE_STC=0 VENDOR=anameIchose" perl Build.PL --wxWidgets-userpatch=/some/path/to/user.patch If you have automated building scripts and use some wxWidgets customisations you may give the path to a patch file (unified diff style) to be applied to the wxWidgets source. Any standard Alien::wxWidgets patches will be applied first. perl Build.PL --prefix Set a custom installation prefix. Works exactly the same as perl Makefile.PL PREFIX=/some/path e.g. --prefix=/some/custom/path =cut Alien-wxWidgets-0.69/inc000775000000000000 013075252613 15571 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/latest.pm000664000000000000 23712306621540 17537 0ustar00unknownunknown000000000000# This stub created by inc::latest 0.3603 package inc::latest; use strict; use vars '@ISA'; require inc::latest::private; @ISA = qw/inc::latest::private/; 1; Alien-wxWidgets-0.69/inc/My000775000000000000 013075252612 16155 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/My/Build.pm000664000000000000 137312306621537 17717 0ustar00unknownunknown000000000000package My::Build; use strict; use base qw(Module::Build); use Config; use File::Spec; our @ISA; $main::NO_INIT = $main::NO_INIT; # no warnings... sub awx_get_package { local $_ = $Config{osname}; # Win32 /MSWin32/ and return 'Win32'; # MacOS X is slightly different... /darwin/ and return 'MacOSX_wx_config'; # default return 'Any_wx_config'; } BEGIN { my $package = 'My::Build'; # iterate until fixed point for( ; !$main::NO_INIT; ) { my $full_package = 'My::Build::' . $package->awx_get_package; last if $package eq $full_package; my $file = $full_package . '.pm'; $file =~ s{::}{/}g; require $file; @ISA = ( $full_package ); $package = $full_package; } } 1; Alien-wxWidgets-0.69/inc/My/Build000775000000000000 013075252612 17214 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/My/Build/Any_wx_config.pm000664000000000000 2241612306621537 22532 0ustar00unknownunknown000000000000package My::Build::Any_wx_config; use strict; use base qw(My::Build::Any_wx_config_Bakefile); use My::Build::Utility qw(awx_arch_dir awx_install_arch_dir); our $WX_CONFIG_LIBSEP; our @LIBRARIES = qw(base net xml adv animate aui core fl gizmos gl html media propgrid qa ribbon richtext stc webview xrc); our @MONO_LIBRARIES_2_9 = qw(core gl); our @MONO_LIBRARIES_2_8 = qw(core stc gl); our @CONTRIB_LIBRARIES = qw(gizmos_xrc ogl plot svg); our @CRITICAL = qw(base core); our @IMPORTANT = qw(net xml adv aui gl html media richtext stc xrc ); my $initialized; my( $wx_debug, $wx_unicode, $wx_monolithic ); sub _find { my( $name ) = @_; return $name if File::Spec->file_name_is_absolute( $name ); foreach my $dir ( File::Spec->path ) { my $abs = File::Spec->catfile( $dir, $name ); return $abs if -x $abs; } return $name; } sub _init { my $build = shift; return if $initialized; $initialized = 1; lib->import( qw(lib inc) ); my $wx_config = ( $build && $build->notes( 'wx_config' ) ) || $ENV{WX_CONFIG} || 'wx-config'; my $ver = `$wx_config --version` or die "Can't execute '$wx_config': $!"; $build->notes( 'wx_config' => _find( $wx_config ) ) if $build && !$build->notes( 'wx_config' ); $ver = __PACKAGE__->_version_2_dec( $ver ); my $base = `$wx_config --basename`; $wx_debug = $base =~ m/d$/ ? 1 : 0; $wx_unicode = $base =~ m/ud?$/ ? 1 : 0; $WX_CONFIG_LIBSEP = `$wx_config --libs base > /dev/null 2>&1 || echo 'X'` eq "X\n" ? '=' : ' '; $wx_monolithic = `$wx_config --libs${WX_CONFIG_LIBSEP}adv` eq `$wx_config --libs${WX_CONFIG_LIBSEP}core`; sub awx_is_debug { $_[0]->notes( 'build_wx' ) ? $_[0]->SUPER::awx_is_debug : $wx_debug; } sub awx_is_unicode { $_[0]->notes( 'build_wx' ) ? $_[0]->SUPER::awx_is_unicode : $wx_unicode; } sub awx_is_monolithic { $_[0]->notes( 'build_wx' ) ? $_[0]->SUPER::awx_is_monolithic : $wx_monolithic; } } package My::Build::Any_wx_config::Base; use strict; use base qw(My::Build::Base); use Fatal qw(chdir mkdir); use Cwd (); use Config; use My::Build::Utility qw(awx_arch_dir awx_install_arch_dir); sub awx_configure { My::Build::Any_wx_config::_init( $_[0] ); my $self = shift; my %config = $self->SUPER::awx_configure; my $cf = $self->wx_config( 'cxxflags' ); $config{prefix} = $self->wx_config( 'prefix' ); $cf =~ m/__WX(x11|msw|motif|gtk|mac|osx_carbon|osx_cocoa)__/i or die "Unable to determine toolkit!"; $config{config}{toolkit} = lc $1; $config{config}{build} = $self->awx_is_monolithic ? 'mono' : 'multi'; if( $config{config}{toolkit} eq 'gtk' ) { $self->wx_config( 'basename' ) =~ m/(gtk2?)/i or die 'PANIC: ', $self->wx_config( 'basename' ); $config{config}{toolkit} = lc $1; } $config{compiler} = $ENV{CXX} || $self->wx_config( 'cxx' ); if( $self->awx_debug ) { $config{c_flags} .= ' -g '; } my $cccflags = $self->wx_config( 'cxxflags' ); my $libs = $self->wx_config( 'libs' ); foreach ( split /\s+/, $cccflags ) { m(^[-/]I) && do { $config{include_path} .= "$_ "; next; }; m(^[-/]D) && do { $config{defines} .= "$_ "; next; }; $config{c_flags} .= "$_ "; } my @paths = ( ( map { s/^-L//; $_ } grep { /^-L/ } split ' ', $libs ), qw(/usr/local/lib /usr/lib /usr/lib64) ); foreach ( split /\s+/, $libs ) { m{^-[lL]|/} && do { $config{link_libraries} .= " $_"; next; }; if( $_ eq '-pthread' && $^O =~ m/(?:linux|freebsd)/i ) { $config{link_libraries} .= " -lpthread"; next; } $config{link_libraries} .= " $_"; } my %dlls = %{$self->wx_config( 'dlls' )}; $config{_libraries} = {}; while( my( $k, $v ) = each %dlls ) { if( @paths ) { my $found = 0; foreach my $path ( @paths ) { $found = 1 if -f File::Spec->catfile( $path, $v->{dll} ); } unless( $found || $self->notes( 'build_wx' ) ) { if( grep $_ eq $k, @My::Build::Any_wx_config::CRITICAL ) { warn "'$k' library not found: can't use wxWidgets\n"; } elsif( grep $_ eq $k, @My::Build::Any_wx_config::IMPORTANT ) { warn "'$k' library not found: some functionality will be missing\n"; } next; } } $config{_libraries}{$k} = $v; } return %config; } sub _call_wx_config { My::Build::Any_wx_config::_init( $_[0] ); my $self = shift; my $options = join ' ', map { "--$_" } @_; my $wx_config = $self->notes( 'wx_config' ) || $ENV{WX_CONFIG} || 'wx-config'; # not completely correct, but close $options = "--static $options" if $self->awx_static; my $t = qx($wx_config $options); chomp $t; return $t; } sub awx_compiler_kind { My::Build::Any_wx_config::_init( $_[0] ); return Alien::wxWidgets::Utility::awx_compiler_kind( $_[1] ) } sub awx_dlext { $Config{dlext} } sub _key { my $self = shift; my $compiler = $ENV{CXX} || $Config{ccname} || $Config{cc}; my $key = $self->awx_get_name ( toolkit => $self->awx_build_toolkit, version => $self->_version_2_dec ( $self->notes( 'build_data' )->{data}{version} ), debug => $self->awx_is_debug, unicode => $self->awx_is_unicode, mslu => $self->awx_is_mslu, # it is unlikely it will ever be required under *nix $self->notes( 'build_wx' ) ? () : ( compiler => $self->awx_compiler_kind( $compiler ), compiler_version => $self->awx_compiler_version( $compiler ) ), ); return $key; } sub wxwidgets_configure_extra_flags { my $self = shift; my $extraflags = $self->notes( 'extraflags' ); if( $self->notes( 'graphicscontext' ) ) { $extraflags .= ' --enable-graphics_ctx'; } return $extraflags; } sub awx_make { my( $self ) = @_; my $make = 'make'; if( $^O eq 'solaris' ) { $make = $self->awx_path_search( 'gmake' ); die "GNU make required under Solaris" unless $make; } return $make; } sub awx_version_type { my $self = shift; my $versiontype = ( $self->notes( 'build_data' )->{data}{version} =~ /^2\.(6|7|8)/ ) ? 2 : 3; return $versiontype; } sub build_wxwidgets { my $self = shift; my $extra_flags = $self->wxwidgets_configure_extra_flags; my $prefix_dir = $self->_key; my $prefix = awx_install_arch_dir( $self, $prefix_dir ); my $opengl = $self->notes( 'build_wx_opengl' ); my $args = sprintf '--with-%s %s--disable-compat24', $self->awx_build_toolkit, $opengl ? '--with-opengl ' : ''; my $unicode = $self->awx_is_unicode ? 'enable' : 'disable'; my $debug = ''; if( $self->awx_version_type == 2 ) { $debug = ( $self->awx_debug ) ? '--enable-debug' : '--disable-debug'; } else { $debug = ( $self->awx_debug ) ? '--enable-debug=max' : ''; } my $monolithic = $self->awx_is_monolithic ? 'enable' : 'disable'; my $universal = $self->awx_is_universal ? 'enable' : 'disable'; my $dir = $self->notes( 'build_data' )->{data}{directory}; my $cmd = "echo exit | " . # for OS X 10.3... "sh ../configure --prefix=$prefix $args --$unicode-unicode" . " $debug --$monolithic-monolithic" . " --$universal-universal_binary $extra_flags"; my $old_dir = Cwd::cwd; chdir $dir; # do not reconfigure unless necessary mkdir 'bld' unless -d 'bld'; chdir 'bld'; # print $cmd, "\n"; $self->_system( $cmd ) unless -f 'Makefile'; my $make = $self->awx_make; $self->_system( "$make all" ); if( $self->awx_version_type == 2 ) { chdir 'contrib/src/stc'; $self->_system( "$make all" ); } chdir $old_dir; } sub massage_environment { my( $self ) = shift; if( $self->notes( 'build_wx' ) ) { my $wxc = File::Spec->rel2abs ( File::Spec->catfile ( $self->notes( 'build_data' )->{data}{directory}, 'bld', 'wx-config' ) ); # find the real and non-inplace wx-config while( -l $wxc ) { my $to = readlink $wxc; my( $vol, $dir, $file ) = File::Spec->splitpath( $wxc ); $wxc = File::Spec->catfile( $dir, $to ); } $wxc =~ s{/inplace-([^/]+)$}{/$1}; $ENV{WX_CONFIG} = $wxc; } } sub install_wxwidgets { } sub install_system_wxwidgets { my( $self ) = shift; return unless $self->notes( 'build_wx' ); my $dir = $self->notes( 'build_data' )->{data}{directory}; my $old_dir = Cwd::cwd; my $destdir = $self->destdir ? ' DESTDIR=' . $self->destdir : ''; chdir $dir; chdir 'bld'; my $make = $self->awx_make; $self->_system( "$make install" . $destdir ); if( $self->awx_version_type == 2 ) { chdir 'contrib/src/stc'; $self->_system( "$make install" . $destdir ); } chdir $old_dir; } sub awx_build_toolkit { 'gtk' } 1; Alien-wxWidgets-0.69/inc/My/Build/Any_wx_config_Bakefile.pm000664000000000000 411012306621537 24263 0ustar00unknownunknown000000000000package My::Build::Any_wx_config_Bakefile; use strict; our @ISA = qw(My::Build::Any_wx_config::Base); use Config; sub awx_wx_config_data { my $self = shift; return $self->{awx_data} if $self->{awx_data}; my %data; foreach my $item ( qw(cxx ld cxxflags version libs basename prefix) ) { $data{$item} = $self->_call_wx_config( $item ); } $data{ld} =~ s/\-o\s*$/ /; # wxWidgets puts 'ld -o' into LD $data{libs} =~ s/\-lwx\S+//g; my @mono_libs = $self->_version_2_dec( $data{version} ) >= 2.009 ? @My::Build::Any_wx_config::MONO_LIBRARIES_2_9 : @My::Build::Any_wx_config::MONO_LIBRARIES_2_8; my $arg = 'libs' . $My::Build::Any_wx_config::WX_CONFIG_LIBSEP . join ',', grep { !m/base/ } ( $self->awx_is_monolithic ? @mono_libs : @My::Build::Any_wx_config::LIBRARIES ); my $libraries = $self->_call_wx_config( $arg ); my( $libname_re, $libsuffix ); if( $^O eq 'openbsd' ) { $libname_re = '-l(.*_(\w+))'; $libsuffix = '.1.0'; } else { $libname_re = '-l(.*_(\w+)-.*)'; $libsuffix = ''; } foreach my $lib ( grep { m/\-lwx/ } split ' ', $libraries ) { $lib =~ m/$libname_re/ or die $lib; my( $key, $name ) = ( $2, $1 ); $key = 'base' if $key =~ m/^base[ud]{0,2}/; $key = 'base' if $key =~ m/^carbon|^cocoa/ && $name !~ /osx_/; # here for Mac $key = 'core' if $key =~ m/^carbon|^cocoa/ && $name =~ /osx_/; # here for Mac $key = 'core' if $key =~ m/^mac[ud]{0,2}/; $key = 'core' if $key =~ m/^gtk2?[ud]{0,2}/ && $self->awx_is_monolithic && $lib =~ m/(?:gtk2?|mac)[ud]{0,2}-/; my $dll = "lib${name}." . $self->awx_dlext . $libsuffix; $data{dlls}{$key} = { dll => $dll, link => $lib }; } if( $self->awx_is_monolithic ) { $data{dlls}{mono} = delete $data{dlls}{core}; } $self->{awx_data} = \%data; } 1; Alien-wxWidgets-0.69/inc/My/Build/Base.pm000664000000000000 3176113072207665 20620 0ustar00unknownunknown000000000000package My::Build::Base; use strict; use base qw(Module::Build); use My::Build::Utility qw(awx_arch_file awx_touch); use Alien::wxWidgets::Utility qw(awx_sort_config awx_grep_config); use File::Path (); use File::Basename (); use Fatal qw(open close unlink); use Data::Dumper; use File::Glob qw(bsd_glob); use Carp; use lib '.'; # Ensure deterministic output $Data::Dumper::Sortkeys = 1; # use the system version of a module if present; in theory this could lead to # compatibility problems (if the latest version of one of the dependencies, # installed in @INC is incompatible with the bundled version of a module) sub _load_bundled_modules { # the load order is important: all dependencies must be loaded # before trying to load a module require inc::latest; inc::latest->import( $_ ) foreach qw(version Locale::Maketext::Simple Params::Check Module::Load Module::Load::Conditional IPC::Cmd Archive::Extract File::Fetch); } sub ACTION_build { my $self = shift; # try to make "perl Makefile.PL && make test" work # but avoid doubly building wxWidgets when doing # "perl Makefile.PL && make && make test" unlink 'configured' if -f 'configured'; $self->SUPER::ACTION_build; } sub ACTION_code { my $self = shift; $self->SUPER::ACTION_code; # install_only is set when a wxWidgets build is already configured # with Alien::wxWidgets return if $self->notes( 'install_only' ); # see comment in ACTION_build for why 'configured' is used return if -f 'configured'; $self->depends_on( 'build_wx' ); $self->create_config_file( awx_arch_file( 'Config/Config.pm' ) ); $self->install_wxwidgets; # see comment in ACTION_build for why 'configured' is used awx_touch( 'configured' ); $self->add_to_cleanup( 'configured' ); } sub ACTION_build_wx { my $self = shift; if( $self->notes( 'build_wx' ) ) { $self->fetch_wxwidgets; $self->extract_wxwidgets; $self->massage_environment; $self->build_wxwidgets; $self->massage_environment; # twice on purpose } } sub ACTION_build_perl { my $self = shift; $self->SUPER::ACTION_build; $self->massage_environment; $self->create_config_file( awx_arch_file( 'Config/Config.pm' ) ); } sub ACTION_install_wx { my $self = shift; $self->depends_on( 'build_perl' ); $self->install_wxwidgets; } sub ACTION_install { my $self = shift; $self->SUPER::ACTION_install; $self->install_system_wxwidgets; } sub _check_data_file { my( $self, $file, $manifest ) = @_; require File::Spec::Unix; my $data = do { package main; our( $TYPE, $URL ); local $TYPE = 'dummy'; local $URL = 'dummy'; do $file; }; die "Unable to load data file '$file': $@" unless $data; foreach my $p ( qw(msw mac unix) ) { next unless exists $data->{$p}; foreach my $c ( qw(unicode ansi) ) { next unless exists $data->{$p}{$c}; foreach my $f ( @{$data->{$p}{$c}} ) { my $file = File::Spec->catfile( 'patches', $f ); my $manifest_file = File::Spec::Unix->catfile( 'patches', $f ); die 'Missing patch file: ', $file, "\n" unless -f $file; die 'Patch file ', $file, ' not in MANIFEST' unless exists $manifest->{$manifest_file}; } } } } sub _check_data_files { my( $self ) = @_; require ExtUtils::Manifest; my $files = ExtUtils::Manifest::maniread(); foreach my $data ( grep m{^patches/data}, keys %$files ) { print "Checking $data\n"; $self->_check_data_file( $data, $files ); } } sub ACTION_distcheck { my $self = shift; $self->SUPER::ACTION_distcheck; $self->_check_data_files; } sub ACTION_dist { my $self = shift; $self->_check_data_files; $self->SUPER::ACTION_dist; } sub awx_key { my( $self ) = @_; die unless $self->{awx_key}; return $self->{awx_key}; } sub _version_2_dec { my( $class, $ver ) = @_; my $dec; $ver =~ m/^(\d)(\d)$/ and $dec = $1 + $2 / 1000; $ver =~ m/^(\d)(\d)(\d+)$/ and $dec = $1 + $2 / 1000 + $3 / 1000000; $ver =~ m/^(\d)(\d+)_(\d+)$/ and $dec = $1 + $2 / 1000 + $3 / 1000000; $ver =~ m/^(\d+)\.(\d+)\.(\d+)$/ and $dec = $1 + $2 / 1000 + $3 / 1000000; return sprintf( "%.6f", $dec ); } sub _init_config { my( $self ) = @_; my %config = $self->awx_configure; my $ver = $self->awx_wx_config_data->{version}; $self->{awx_config} = \%config; $config{version} = $self->_version_2_dec( $ver ); $config{compiler} = $ENV{CXX} || $self->awx_wx_config_data->{cxx}; $config{linker} = $self->awx_wx_config_data->{ld}; $config{config}{compiler_kind} = $self->notes( 'compiler_kind' ) || $self->awx_compiler_kind( $config{compiler} ); $config{config}{compiler_version} = $self->notes( 'compiler_version' ) || $self->awx_compiler_version( $config{compiler} ); $self->notes( 'compiler_kind' => $config{config}{compiler_kind} ); $self->notes( 'compiler_version' => $config{config}{compiler_version} ); my $base = $self->awx_get_name ( toolkit => $config{config}{toolkit}, version => $config{version}, debug => $self->awx_is_debug, unicode => $self->awx_is_unicode, mslu => $self->awx_is_mslu, compiler => $config{config}{compiler_kind}, compiler_version => $config{config}{compiler_version}, ); $self->{awx_key} = $base; $config{wx_base_directory} = $self->awx_wx_config_data->{wxdir} if $self->awx_wx_config_data->{wxdir}; $config{alien_base} = $self->{awx_base} = $base; $config{alien_package} = "Alien::wxWidgets::Config::${base}"; return %config; } sub create_config_file { my( $self, $file ) = @_; my $directory = File::Basename::dirname( $file ); my %config = $self->_init_config; my $base = $self->awx_key; my $body = Data::Dumper->Dump( [ \%config ] ); $body =~ s/rEpLaCe/$base/g; File::Path::mkpath( $directory ) or die "mkpath '$directory': $!" unless -d $directory; open my $fh, '> ' . File::Spec->catfile( $directory, $base . '.pm' ); print $fh <<"EOT"; package $config{alien_package}; EOT print $fh <<'EOT'; use strict; our %VALUES; { no strict 'vars'; %VALUES = %{ EOT print $fh $body ; print $fh <<'EOT'; }; } my $key = substr __PACKAGE__, 1 + rindex __PACKAGE__, ':'; EOT print $fh <<'EOT' if $self->notes( 'mk_portable' ) && ( $^O =~ /^MSWin/ ); my ($portablebase); my $wxwidgetspath = __PACKAGE__ . '.pm'; $wxwidgetspath =~ s/::/\//g; for (@INC) { if( -f qq($_/$wxwidgetspath ) ) { $portablebase = qq($_/Alien/wxWidgets/$key); last; } } if( $portablebase ) { $portablebase =~ s{/}{\\}g; my $portablelibpath = qq($portablebase\\lib); my $portableincpath = qq($portablebase\\include); $VALUES{include_path} = qq{-I$portablelibpath -I$portableincpath}; $VALUES{link_libraries} =~ s{-L\S+\s}{-L$portablelibpath }; $VALUES{shared_library_path} = $portablelibpath; $VALUES{wx_base_directory} = $portablebase; $VALUES{prefix} = $portablebase; } EOT print $fh <<'EOT'; sub values { %VALUES, key => $key } sub config { +{ %{$VALUES{config}}, package => __PACKAGE__, key => $key, version => $VALUES{version}, } } 1; EOT close $fh; } sub fetch_wxwidgets { my $self = shift; return if -f $self->notes( 'build_data' )->{data}{archive}; $self->_load_bundled_modules; print "Fetching wxWidgets...\n"; print "fetching from: ", $self->notes( 'build_data' )->{data}{url}, "\n"; my $path = File::Fetch->new ( uri => $self->notes( 'build_data' )->{data}{url} )->fetch; die 'Unable to fetch archive' unless $path; } sub extract_wxwidgets { my $self = shift; return if -d $self->notes( 'build_data' )->{data}{directory}; my $archive = $self->notes( 'build_data' )->{data}{archive}; print "Extracting wxWidgets...\n"; $self->_load_bundled_modules; $Archive::Extract::PREFER_BIN = ( $^O =~ /^mswin/i ) ? 0 : 1; my $ae = Archive::Extract->new( archive => $archive ); die 'Error: ', $ae->error unless $ae->extract; $self->patch_wxwidgets; } sub patch_wxwidgets { my $self = shift; my $old_dir = Cwd::cwd(); my @patches = $self->awx_wx_patches; if( my $userpatch = $self->notes( 'userpatch' ) ) { die qq(User specified patch $userpatch not found.) if !-f $userpatch; push( @patches, $userpatch ); } print "Patching wxWidgets...\n"; my $wx_dir = $self->notes( 'build_data' )->{data}{directory}; my $build_dir = File::Spec->rel2abs( $wx_dir ); chdir $wx_dir; foreach my $i ( @patches ) { print "Applying patch: ", $i, "\n"; my $cmd = $self->_patch_command( $build_dir, $i ); print $cmd, "\n"; system $cmd and die 'Error: ', $?; } chdir $old_dir; } sub _patch_command { my( $self, $base_dir, $patch_file ) = @_; $patch_file = File::Spec->abs2rel( $patch_file, $base_dir ); my $cmd = $^X . ' ' . File::Spec->catfile( File::Spec->updir, qw(inc bin patch) ) . " -N -p0 -u -b .bak < $patch_file"; return $cmd; } sub build_wxwidgets { die "Don't know how to build wxWidgets"; } sub install_wxwidgets { return unless $_[0]->notes( 'build_wx' ); die "Don't know how to build wxWidgets"; } sub install_system_wxwidgets { } sub awx_configure { my $self = shift; return %{$self->{awx_config}} if $self->{awx_config}; my %config; $config{config}{debug} = $self->awx_is_debug; $config{config}{unicode} = $self->awx_is_unicode; $config{config}{mslu} = $self->awx_is_mslu; $config{config}{build} = $self->awx_is_monolithic ? 'mono' : 'multi'; $config{link_flags} = ''; $config{c_flags} = ''; return %config; } sub wx_config { my $self = shift; my $data = $self->awx_wx_config_data; foreach ( @_ ) { warn "Undefined key '", $_, "' in wx_config" unless defined $data->{$_}; } return @{$data}{@_}; } sub awx_monolithic { $_[0]->args( 'wxWidgets-monolithic' ) ? 1 : 0 } sub awx_is_monolithic { $_[0]->awx_monolithic } sub awx_debug { $_[0]->args( 'wxWidgets-debug' ) ? 1 : 0 } sub awx_is_debug { $_[0]->awx_debug } sub awx_unicode { $_[0]->notes( 'build_wx_unicode' ) || $_[0]->args( 'wxWidgets-unicode' ) ? 1 : 0 } sub awx_is_unicode { $_[0]->awx_unicode } sub awx_mslu { 0 } sub awx_is_mslu { $_[0]->awx_mslu } sub awx_static { $_[0]->args( 'wxWidgets-static' ) ? 1 : 0 } sub awx_is_static { $_[0]->awx_static } sub awx_universal { $_[0]->args( 'wxWidgets-universal' ) ? 1 : 0 } sub awx_is_universal { $_[0]->awx_universal } sub awx_get_package { local $_ = $_[0]; s/^My::Build:://; return $_ } sub awx_wx_patches { my $self = shift; my $data = $self->notes( 'build_data' ); my $toolkit = $^O eq 'MSWin32' ? 'msw' : $^O eq 'darwin' ? 'mac' : 'unix'; my $unicode = $self->awx_unicode ? 'unicode' : 'ansi'; return unless exists $data->{$toolkit} and $data->{$toolkit}{$unicode}; return map { File::Spec->rel2abs( File::Spec->catfile( 'patches', $_ ) ) } @{$data->{$toolkit}{$unicode}}; } sub awx_version_type { my $self = shift; my $versiontype = ( $self->notes( 'build_data' )->{data}{version} =~ /^2\.(6|7|8)/ ) ? 2 : 3; return $versiontype; } sub awx_get_name { my( $self, %args ) = @_; my $e = sub { defined $_[0] ? ( $_[0] ) : () }; my $pv = sub { join '.', map { 0 + ( $_ || 0 ) } ( $_[0] =~ /(\d+)\.(\d{1,3})(\d{0,3})/ ) } ; my $base = join '-', $args{toolkit}, $pv->( $args{version} ), $e->( $args{debug} ? 'dbg' : undef ), $e->( $args{unicode} ? 'uni' : undef ), $e->( $args{mslu} ? 'mslu' : undef ), $e->( $args{compiler} ), $e->( $args{compiler_version} ), ; $base =~ s/\./_/g; $base =~ s/-/_/g; return $base; } sub awx_compiler_kind { 'nc' } # as in 'No Clue' sub awx_compiler_version { return Alien::wxWidgets::Utility::awx_cc_abi_version( $_[1] ); } sub awx_path_search { my( $self, $file ) = @_; foreach my $d ( File::Spec->path ) { my $full = File::Spec->catfile( $d, $file ); # we are gonna use glob() to accept wildcards foreach my $f ( bsd_glob( $full ) ) { return $f if -f $f; } } return; } sub awx_uses_bakefile { 1 } sub ACTION_ppmdist { my( $self ) = @_; $self->awx_strip_dlls; $self->_system( 'perl script/make_ppm.pl' ); } sub _system { shift; my $ret; $ret = @_ > 1 ? system @_ : system $_[0]; $ret and croak "system: @_: $?"; } 1; Alien-wxWidgets-0.69/inc/My/Build/MacOSX_wx_config.pm000664000000000000 754413072207227 23057 0ustar00unknownunknown000000000000package My::Build::MacOSX_wx_config; use strict; use base qw(My::Build::Any_wx_config); use Config; sub awx_wx_config_data { my $self = shift; return $self->{awx_data} if $self->{awx_data}; my %data = ( linkflags => '', %{$self->SUPER::awx_wx_config_data} ); # MakeMaker does not like some options $data{libs} =~ s{-framework\s+\w+}{}g; $data{libs} =~ s{-isysroot\s+\S+}{}g; $data{libs} =~ s{-L/usr/local/lib\s}{}g; $data{libs} =~ s{\s(-arch\s+\w+)} {$data{linkflags} .= " $1 "; $data{cxxflags} .= " $1 "; ' '}eg; $data{cxx} =~ s{-isysroot\s+\S+}{}g; $data{ld} = $data{cxx}; $data{cxxflags} .= ' -UWX_PRECOMP '; $self->{awx_data} = \%data; } sub awx_configure { my $self = shift; my %config = $self->SUPER::awx_configure; $config{link_flags} .= $self->wx_config( 'linkflags' ); return %config; } sub wxwidgets_configure_extra_flags { my( $self ) = @_; my $extra_flags = $self->notes( 'extraflags' ); if($extra_flags) { # user has given overrides if( $self->notes( 'graphicscontext' ) ) { $extra_flags .= ' --enable-graphics_ctx'; } return $extra_flags; } my $darwinver = 100; if(`uname -r` =~ /^(\d+)\./) { $darwinver = $1; } # we are determining extra flags $extra_flags = ''; # Simplified build if( $darwinver <= 9 ) { # Tiger && Leopard print "Forcing wxWidgets build to 32 bit\n"; $extra_flags .= ' ' . join ' ', map { qq{$_="-arch i386"} } qw(CFLAGS CXXFLAGS LDFLAGS OBJCFLAGS OBJCXXFLAGS); } elsif( $darwinver == 10 ) { # Snow Leopard # just find the right SDK and accept users arch flags my $sdk1 = qq(/Developer/SDKs/MacOSX10.6.sdk); my $sdk2 = qq(/Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.6.sdk); my $macossdk = ( -d $sdk2 ) ? $sdk2 : $sdk1; if( -d $macossdk ) { $extra_flags .= qq( --with-macosx-version-min=10.6 --with-macosx-sdk=${macossdk}); } } else { # Lion and later - accept default SDK and set min version 10.7 $extra_flags .= qq( --with-macosx-version-min=10.7); } $extra_flags .= ' --enable-graphics_ctx'; # now check for flags needed for different xcode versions { my $xcodestring = qx(xcodebuild -version) || ''; if ($xcodestring =~ /Xcode\s+(\d+)\.(\d+)/ ) { my $majorxcodever = $1; my $minorxcodever = $2; if (( $majorxcodever > 4 ) || ( $majorxcodever == 4 && $minorxcodever > 3 )) { $extra_flags .= q( CC=clang CXX=clang++ CXXFLAGS="-stdlib=libc++ -std=c++11" OBJCXXFLAGS="-stdlib=libc++ -std=c++11" LDFLAGS=-stdlib=libc++); } } } return $extra_flags; } sub awx_build_toolkit { my $self = shift; # use Cocoa for OS X wxWidgets >= 2.9 # we don't support lower than 2.8 anymore if( $self->awx_version_type == 2) { return 'mac'; } else { return 'osx_cocoa'; } } sub awx_dlext { 'dylib' } sub build_wxwidgets { my( $self ) = @_; # can't build wxWidgets 2.8.x with 64 bit Perl if( $Config{ptrsize} == 8 && $self->awx_version_type == 2 ) { print <SUPER::build_wxwidgets; } 1; Alien-wxWidgets-0.69/inc/My/Build/Utility.pm000664000000000000 314412306621537 21360 0ustar00unknownunknown000000000000package My::Build::Utility; use strict; use base qw(Exporter); use Config; use Fatal qw(open); our @EXPORT_OK = qw(awx_arch_file awx_install_arch_file awx_install_arch_auto_file awx_arch_dir awx_install_arch_dir awx_touch); sub awx_arch_file { my( $vol, $dir, $file ) = File::Spec->splitpath( $_[0] || '' ); File::Spec->catfile( 'blib', 'arch', 'Alien', 'wxWidgets', File::Spec->splitdir( $dir ), $file ); } sub awx_arch_dir { my( $vol, $dir, $file ) = File::Spec->splitpath( $_[0] || '' ); File::Spec->catdir( 'blib', 'arch', 'Alien', 'wxWidgets', File::Spec->splitdir( $dir ), $file ); } sub awx_install_arch_file { my( $build, $p ) = @_; my( $vol, $dir, $file ) = File::Spec->splitpath( $p || '' ); File::Spec->catfile( $build->install_destination( 'arch' ), 'Alien', 'wxWidgets', File::Spec->splitdir( $dir ), $file ); } sub awx_install_arch_dir { my( $build, $p ) = @_; my( $vol, $dir, $file ) = File::Spec->splitpath( $p || '' ); File::Spec->catdir( $build->install_destination( 'arch' ), 'Alien', 'wxWidgets', File::Spec->splitdir( $dir ), $file ); } sub awx_install_arch_auto_file { my( $build, $p ) = @_; my( $vol, $dir, $file ) = File::Spec->splitpath( $p || '' ); File::Spec->catfile( $build->install_destination( 'arch' ), 'auto', 'Alien', 'wxWidgets', File::Spec->splitdir( $dir ), $file ); } sub awx_touch { require ExtUtils::Command; local @ARGV = @_; ExtUtils::Command::touch(); } 1; Alien-wxWidgets-0.69/inc/My/Build/Win32.pm000664000000000000 2400612313701141 20623 0ustar00unknownunknown000000000000package My::Build::Win32; use strict; use base qw(My::Build::Base); use My::Build::Utility qw(awx_arch_file awx_install_arch_file awx_install_arch_dir); use Config; use Fatal qw(open close); use Carp qw(cluck); use File::Glob qw(bsd_glob); my $initialized; sub _init { return if $initialized; $initialized = 1; return if Module::Build->current->notes( 'build_wx' ); # install_only is set when a wxWidgets build is already configured # with Alien::wxWidgets return if Module::Build->current->notes( 'install_only' ); # check for WXDIR and WXWIN environment variables unless( exists $ENV{WXDIR} or exists $ENV{WXWIN} ) { cluck <catfile( File::Spec->updir, qw(inc bin patch.exe) ); my $cmd = qq{perl -pe "" -- "$patch_file"} . qq{ | "$patch_exe" -N -p0 -u -b -z .bak}; return $cmd; } sub awx_grep_dlls { my( $self, $libdir, $digits, $mono ) = @_; my $ret = {}; my $ver = $self->_version_2_dec( $self->awx_w32_bakefile_version ); my $suff = ( $self->awx_unicode ? 'u' : '' ) . ( $self->awx_debug && $ver <= 2.009 ? 'd' : '' ); my @dlls = grep { m/${digits}\d*${suff}_/ } bsd_glob( File::Spec->catfile( $libdir, '*.dll' ) ); my @libs = grep { m/(?:lib)?wx(?:wince|msw|base)[\w\.]+$/ } grep { m/${digits}\d*${suff}(_|\.)/ } bsd_glob( File::Spec->catfile( $libdir, "*$Config{lib_ext}" ) ); # we want builtins on Win32 so that they are available for wxWidgets extensions my @builtins = grep { m/wx(zlib|regex|expat|png|jpeg|tiff)/ } bsd_glob( File::Spec->catfile( $libdir, "*$Config{lib_ext}" ) ); $self->{w32builtins} = \@builtins; foreach my $full ( @dlls, @libs ) { my( $name, $type ); local $_ = File::Basename::basename( $full ); m/^[^_]+_([^_\.]+)/ and $name = $1; $name = 'base' if !defined $name || $name =~ m/^(gcc|vc|evc)$/; $type = m/$Config{lib_ext}$/i ? 'lib' : 'dll'; $ret->{$name}{$type} = $full; } if( $mono ) { $ret->{mono} = delete $ret->{base}; } die "Configuration error: could not find libraries for configuration: " . join ' ', map "'$_'", $suff, $digits unless ( exists $ret->{core}{dll} and exists $ret->{core}{lib} ) or ( exists $ret->{mono}{dll} and exists $ret->{mono}{lib} ); return $ret; } sub awx_wx_config_data { my $self = shift; my $wxdir_b = $ENV{WXDIR}; my $wxdir = $self->notes( 'build_wx' ) ? awx_install_arch_dir( $self, 'rEpLaCe' ) : $wxdir_b; return { 'wxdir' => $wxdir, 'wxdir_build' => $wxdir_b, 'wxinc' => File::Spec->catdir( $wxdir_b, 'include' ), 'wxcontrinc' => File::Spec->catdir( $wxdir_b, 'contrib', 'include' ), }; } sub awx_configure { my $self = shift; my %config = $self->SUPER::awx_configure; $config{prefix} = $self->wx_config( 'wxdir' ); $config{config}{toolkit} = $self->is_wince ? 'wce' : 'msw'; $config{shared_library_path} = awx_install_arch_file( $self, "rEpLaCe/lib" ); $self->awx_w32_find_setup_dir( $self->wx_config( 'cxxflags' ) ); return %config; } sub awx_w32_find_setup_dir { my( $self, $cxxflags ) = @_; die "Unable to find setup.h directory" unless $cxxflags =~ m{[/-]I\s*(\S+lib[\\/][\w\\/]+)(?:\s|$)}; $self->{awx_setup_dir} = $1; $self->{awx_data}{version} = $self->awx_w32_bakefile_version if -f $self->awx_w32_build_cfg; } sub awx_w32_bakefile_version { my $self = shift; my $build_cfg = $self->awx_w32_build_cfg; my $in; open $in, $build_cfg; my %ver = map { split /=/ } grep /^WXVER_/, map { s/\s//g; $_ } <$in>; close $in; return join '.', @ver{qw(WXVER_MAJOR WXVER_MINOR WXVER_RELEASE)}; } sub awx_w32_build_cfg { my $self = shift; File::Spec->catfile( $self->{awx_setup_dir}, 'build.cfg' ) } sub files_to_install { my $self = shift; my $dlls = $self->awx_wx_config_data->{dlls}; my $setup_h = File::Spec->catfile( $self->{awx_setup_dir}, 'wx', 'setup.h' ); my $build_cfg = $self->awx_w32_build_cfg; my %files; $files{$build_cfg} = awx_arch_file( "rEpLaCe/lib/build.cfg" ) if -f $build_cfg; $files{$setup_h} = awx_arch_file( "rEpLaCe/lib/wx/setup.h" ); foreach my $dll ( map { $_->{dll} } values %$dlls ) { next unless defined $dll; my $base = File::Basename::basename( $dll ); $files{$dll} = awx_arch_file( "rEpLaCe/lib/$base" ); } foreach my $lib ( map { $_->{lib} } values %$dlls ) { next unless defined $lib; my $base = File::Basename::basename( $lib ); $files{$lib} = awx_arch_file( "rEpLaCe/lib/$base" ); } if( $self->notes( 'build_wx' ) || $self->notes( 'mk_portable' ) ) { require File::Find; my $no_platform = join '|', qw(unix gtk x11 motif mac cocoa os2 palmos univ mgl msdos gtk1 dfb); my $wx_base = $self->awx_wx_config_data->{wxdir_build}; foreach my $find_base ( File::Spec->catdir( $wx_base, qw(include wx) ), File::Spec->catdir( $wx_base, qw(contrib include wx) ) ) { next unless -d $find_base; my $wanted = sub { $File::Find::prune ||= -d $_ && $_ =~ m{include[/\\]wx[/\\](?:$no_platform)$}; $File::Find::prune ||= -d $_ && $_ =~ m{[/\\]\.svn$}; return unless -f $_; my $rel = File::Spec->abs2rel( $_, $find_base ); $files{$_} = awx_arch_file( "rEpLaCe/include/wx/$rel" ); # print "$_ ==> $files{$_}\n"; }; File::Find::find ( { wanted => $wanted, no_chdir => 1, }, $find_base ); } } for my $builtin ( @{ $self->awx_wx_config_data->{w32builtins} } ) { my $base = File::Basename::basename( $builtin ); $files{$builtin} = awx_arch_file( "rEpLaCe/lib/$base" ); } return %files; } sub copy_wxwidgets { my $self = shift; my %files = $self->files_to_install; while( my( $from, $to ) = each %files ) { $to =~ s/rEpLaCe/$self->{awx_key}/g; $self->copy_if_modified( from => $from, to => $to, verbose => 1 ); } } sub install_wxwidgets { my $self = shift; $self->copy_wxwidgets; } sub awx_get_package { My::Build::Win32::_init(); my $package; return 'WinCE' if $INC{'Cross.pm'}; SWITCH: { local $_ = $Config{ccname} || $Config{cc}; /^cl/i and $package = 'Win32_MSVC' and last SWITCH; /^gcc/i and $package = 'Win32_MinGW' and last SWITCH; # default die "Your compiler is not currently supported on Win32" }; return $package . '_Bakefile'; } # MSLU is off by default. It Must be explicitly enabled sub awx_mslu { return $_[0]->args( 'wxWidgets-mslu' ) if defined $_[0]->args( 'wxWidgets-mslu' ); return 0; } sub massage_environment { my( $self ) = shift; if( $self->notes( 'build_wx' ) ) { $ENV{WXWIN} = $ENV{WXDIR} = File::Spec->rel2abs ( $self->notes( 'build_data' )->{data}{directory} ); } } package My::Build::Win32_Bakefile; use strict; use Carp; use Config; # mixin: no use base sub build_wxwidgets { my $self = shift; my $old_dir = Cwd::cwd(); my $uni = $self->awx_unicode ? 'UNICODE=1' : 'UNICODE=0'; my $mslu = $self->awx_mslu ? 'MSLU=1' : 'MSLU=0'; my $dbg = $self->awx_debug ? 'BUILD=debug' : 'BUILD=release'; my $opt = join ' ', $uni, $mslu, $dbg, 'SHARED=1'; if( my $xbuildflags = $self->awx_w32_extra_buildflags ) { $opt .= ' ' . $xbuildflags; } # help windres in x compiler local $ENV{GNUTARGET} = ( $Config{ptrsize} == 8 ) ? 'pe-x86-64' : 'pe-i386'; chdir File::Spec->catdir( $ENV{WXDIR}, 'build', 'msw' ); $self->_system( $self->_make_command . ' ' . $opt ); chdir File::Spec->catdir( $ENV{WXDIR}, 'contrib', 'build', 'stc' ); $self->_system( $self->_make_command . ' ' . $opt ); chdir $old_dir; } sub awx_w32_configure_extra_flags { my $self = shift; return $self->notes( 'extraflags' ); } sub awx_w32_extra_buildflags { my $self = shift; my $buildflags = ''; my $extraflags = $self->awx_w32_configure_extra_flags; $buildflags .= $extraflags if $extraflags; return $buildflags if !$self->notes('build_wx'); # extra flags for vers != 2.8 - that is >= 2.9 if( $self->awx_version_type == 3 ) { if($self->awx_debug) { $buildflags .= ' DEBUG_INFO=default DEBUG_FLAG=2'; } else { $buildflags .= ' DEBUG_INFO=default DEBUG_FLAG=1'; } } # flags for vers == 2.x if( $self->awx_version_type == 2 ) { # do graphicscontext for 2.8 build if requested if( $self->notes( 'graphicscontext' ) ) { $buildflags .= ' USE_GDIPLUS=1'; } } if( my $ldflags = $self->awx_w32_ldflags ) { # only add if user has not specified LDFLAGS in 'extraflags' if( $extraflags !~ / LDFLAGS=/ ) { $buildflags .= qq( LDFLAGS=\"$ldflags\"); } } if( my $cppflags = $self->awx_w32_cppflags ) { # only add if user has not specified CPPFLAGS in 'extraflags' if( $extraflags !~ / CPPFLAGS=/ ) { $buildflags .= qq( CPPFLAGS=\"$cppflags\"); } } return $buildflags; } sub is_wince { 0 } 1; Alien-wxWidgets-0.69/inc/My/Build/Win32_MSVC.pm000664000000000000 445712306621537 21457 0ustar00unknownunknown000000000000package My::Build::Win32_MSVC; use strict; use base qw(My::Build::Win32); use My::Build::Utility qw(awx_install_arch_file awx_install_arch_dir); use Alien::wxWidgets::Utility qw(awx_cc_version); use Config; sub awx_configure { my $self = shift; my %config = $self->SUPER::awx_configure; $config{c_flags} .= ' -GF -TP '; if( $self->awx_debug ) { $config{link_flags} .= ' -debug '; } my $cccflags = $self->wx_config( 'cxxflags' ); my $libs = $self->wx_config( 'libs' ); my $incdir = $self->awx_wx_config_data->{wxinc}; my $cincdir = $self->awx_wx_config_data->{wxcontrinc}; my $iincdir = awx_install_arch_dir( $self, 'rEpLaCe/include' ); foreach ( split /\s+/, $cccflags ) { m(^-DSTRICT) && next; m(^-I) && do { next if m{(?:regex|zlib|jpeg|png|tiff|expat[\\/]lib)$}; if( $self->notes( 'build_wx' ) ) { $_ =~ s{\Q$cincdir\E}{$iincdir}; $_ =~ s{\Q$incdir\E}{$iincdir}; } if( $_ =~ /-I\Q$self->{awx_setup_dir}\E/ && !$self->is_wince ) { $config{include_path} .= '-I' . awx_install_arch_file( $self, 'rEpLaCe/lib' ) . ' '; } else { $config{include_path} .= "$_ "; } next; }; m(^-D) && do { $config{defines} .= "$_ "; next; }; $config{c_flags} .= "$_ "; } foreach ( split /\s+/, $libs ) { m(wx|unicows)i || next; next if m{(?:(?:zlib|regexu?|expat|png|jpeg|tiff)[uhd]{0,2}\.lib)$}; $config{link_libraries} .= "$_ "; } $config{link_libraries} .= 'msvcprt.lib ' if awx_cc_version( 'cl' ) > 6; my $dlls = $self->awx_wx_config_data->{dlls}; $config{_libraries} = {}; while( my( $key, $value ) = each %$dlls ) { $config{_libraries}{$key} = { map { $_ => File::Basename::basename( $value->{$_} ) } keys %$value }; if( $value->{link} ) { $config{_libraries}{$key}{link} = $value->{link}; } elsif( $value->{lib} ) { $config{_libraries}{$key}{link} = $config{_libraries}{$key}{lib}; } } $config{config}{build} = $self->awx_wx_config_data->{build_kind} || 'multi'; return %config; } sub awx_compiler_kind { 'cl' } sub awx_strip_dlls { } 1; Alien-wxWidgets-0.69/inc/My/Build/Win32_MSVC_Bakefile.pm000664000000000000 1002712313677262 23253 0ustar00unknownunknown000000000000package My::Build::Win32_MSVC_Bakefile; use strict; use base qw(My::Build::Win32_MSVC My::Build::Win32_Bakefile); use My::Build::Utility qw(awx_install_arch_file awx_install_arch_auto_file); use Alien::wxWidgets::Utility qw(awx_capture); use Config; use Fatal qw(chdir); use Cwd (); sub _check_nmake { my $out = awx_capture( 'nmake /?' ); unless( $out =~ m{/U\s}i ) { die "Please use an NMAKE version supporting '-u', not the" . " freely-available one\n"; } } sub awx_wx_config_data { my $self = shift; My::Build::Win32::_init(); $self->_check_nmake(); return $self->{awx_data} if $self->{awx_data}; my %data = ( %{$self->SUPER::awx_wx_config_data}, 'cxx' => 'cl', 'ld' => 'link', ); my $make = File::Basename::basename( lc $Config{make}, '.exe' ); die "PANIC: you are not using nmake!" unless $make eq 'nmake'; my $orig_libdir; my $final = $self->awx_debug ? 'BUILD=debug DEBUG_RUNTIME_LIBS=0' : 'BUILD=release DEBUG_RUNTIME_LIBS=0'; if( my $xbuildflags = $self->awx_w32_extra_buildflags ) { $final .= ' ' . $xbuildflags; } my $unicode = $self->awx_unicode ? 'UNICODE=1' : 'UNICODE=0'; $unicode .= ' MSLU=1' if $self->awx_mslu; my $dir = Cwd::cwd; chdir File::Spec->catdir( $ENV{WXDIR}, 'samples', 'minimal' ); my @t = qx(nmake /nologo /n /a /u /f makefile.vc $final $unicode SHARED=1); my( $accu, $libdir, $digits ); foreach ( @t ) { chomp; m/^\s*echo\s+(.*)>\s*\S+\s*$/ and $accu .= ' ' . $1 and next; s/\@\S+\s*$/$accu/ and undef $accu; if( s/^\s*link\s+// ) { m/\swxmsw(\d+)\S+\.lib/ and $digits = $1; s/\s+\S+\.(exe|res|obj)/ /g; s{[-/]LIBPATH:(\S+)} {$orig_libdir = File::Spec->canonpath ( File::Spec->rel2abs( $1 ) ); '-L' . ( $libdir = awx_install_arch_file( $self, 'rEpLaCe/lib' ) )}egi; $data{libs} = $_; } elsif( s/^\s*cl\s+// ) { s/\s+\S+\.(cpp|pdb|obj)/ /g; s{[-/]I(\S+)}{'-I' . File::Spec->canonpath ( File::Spec->rel2abs( $1 ) )}egi; s{[-/]I(\S+)[\\/]samples[\\/]minimal(\s|$)}{-I$1\\contrib\\include }i; s{[-/]I(\S+)[\\/]samples(\s|$)}{ }i; s{[-/]D(\S+)}{-D$1}g; $data{cxxflags} = $_; } } chdir $dir; die 'Could not find wxWidgets lib directory' unless $libdir; $self->awx_w32_find_setup_dir( $data{cxxflags} ); # for awx_grep_dlls $data{dlls} = $self->awx_grep_dlls( $orig_libdir, $digits, $self->awx_is_monolithic ); $data{w32builtins} = $self->{w32builtins}; $data{version} = $digits; $self->{awx_data} = \%data; } sub _make_command { "nmake -f makefile.vc all " } sub build_wxwidgets { my( $self ) = shift; my $old_dir = Cwd::cwd(); $self->My::Build::Win32_Bakefile::build_wxwidgets( @_ ); # Compiling with MSVC 9 (VS 2008) and probably with VS 2005, the # linker creates a manifest that must be embedded in the DLL to # make it load correctly chdir File::Spec->catdir( $ENV{WXDIR} ); foreach my $dll ( glob( 'lib/vc_dll*/*.dll' ) ) { next unless -f "${dll}.manifest"; $self->_system( 'mt', '-nologo', '-manifest', "${dll}.manifest", "-outputresource:${dll};2" ); unlink "${dll}.manifest"; } chdir $old_dir; } sub awx_w32_ldflags { my $self = shift; my $ldflags = ''; # security cookie lib for Platform SDK 2003 # ActivePerl will configure $Config{libs} # according to cl version. # For other MSVC built Perl, we'll assume # same cl as built Perl is building wxWidgets my $libs = $Config{libs}; if($libs =~ /bufferoverflowU\.lib/i) { $ldflags = 'bufferoverflowU.lib'; } return $ldflags; } sub awx_w32_cppflags { my $self = shift; my $cppflags = ''; for ( qw( -D_USE_32BIT_TIME_T ) ) { $cppflags .= qq( $_) if $Config{ccflags} =~ /$_/; } return $cppflags; } 1; Alien-wxWidgets-0.69/inc/My/Build/Win32_MinGW.pm000664000000000000 1161712313677174 21712 0ustar00unknownunknown000000000000package My::Build::Win32_MinGW; use strict; use base qw(My::Build::Win32); use My::Build::Utility qw(awx_arch_file awx_install_arch_file awx_install_arch_dir awx_arch_dir); use Config; use File::Basename qw(); use File::Glob qw(bsd_glob); use Data::Dumper; sub _find_make { my( @try ) = qw(mingw32-make gmake make); push @try, $Config{gmake} if $Config{gmake}; foreach my $name ( @try ) { foreach my $dir ( File::Spec->path ) { my $abs = File::Spec->catfile( $dir, "$name.exe" ); return $name if -x $abs; } } return 'make'; } sub awx_configure { my $self = shift; my %config = $self->SUPER::awx_configure; my $mxarchflags = ( $Config{ptrsize} == 8 ) ? '-m64' : '-m32'; if( $self->awx_debug ) { $config{c_flags} .= qq( -g $mxarchflags ); $config{link_flags} .= qq( $mxarchflags ); } else { $config{c_flags} .= qq( $mxarchflags ); $config{link_flags} .= qq( -s $mxarchflags ); } my $cccflags = $self->wx_config( 'cxxflags' ); my $libs = $self->wx_config( 'libs' ); my $incdir = $self->awx_wx_config_data->{wxinc}; my $cincdir = $self->awx_wx_config_data->{wxcontrinc}; my $iincdir = awx_install_arch_dir( $self, 'rEpLaCe/include' ); foreach ( split /\s+/, $cccflags ) { m(^-DSTRICT) && next; m(^\.d$) && next; # broken makefile m(^-W.*) && next; # under Win32 -Wall gives you TONS of warnings m(^-I) && do { next if m{(?:regex|zlib|jpeg|png|tiff)$}; if( $self->notes( 'build_wx' ) ) { $_ =~ s{\Q$cincdir\E}{$iincdir}; $_ =~ s{\Q$incdir\E}{$iincdir}; } if( $_ =~ /-I\Q$self->{awx_setup_dir}\E/ ) { $config{include_path} .= '-I' . awx_install_arch_file( $self, 'rEpLaCe/lib' ) . ' '; } else { $config{include_path} .= "$_ "; } next; }; m(^-D) && do { $config{defines} .= "$_ "; next; }; $config{c_flags} .= "$_ "; } foreach ( split /\s+/, $libs ) { m(wx|unicows)i || next; next if m{(?:wx(?:zlib|regexu?|expat|png|jpeg|tiff)[ud]{0,2})$}; $config{link_libraries} .= "$_ "; } my $dlls = $self->awx_wx_config_data->{dlls}; $config{_libraries} = {}; while( my( $key, $value ) = each %$dlls ) { $config{_libraries}{$key} = { map { $_ => File::Basename::basename( $value->{$_} ) } keys %$value }; if( $value->{link} ) { $config{_libraries}{$key}{link} = $value->{link}; } elsif( $value->{lib} ) { my $lib = $config{_libraries}{$key}{lib}; $lib =~ s/^lib(.*?)(?:\.dll)?\.a$/$1/; $config{_libraries}{$key}{link} = '-l' . $lib; } } return %config; } sub awx_compiler_kind { 'gcc' } sub files_to_install { my $self = shift; # wxWidgets dlls may be linked to # libgcc_* ( suffix could be may variants as some mingw dists distinguish between 32 / 64 bit dlls ) # libstdc++* # mingwm10.dll my @searchfordlls; # get the dlls used { # objdump will give us confirmed dll names # while a fallback wildcard search may fail # if multiple different named libcc files exist my $wxdlls = $self->awx_wx_config_data->{dlls}; my $checkfile = ( exists($wxdlls->{base}) ) ? $wxdlls->{base}->{dll} : $wxdlls->{mono}->{dll}; #$checkfile =~ s/\\+/\//g; #print qq(CHECKING FILE $checkfile\n); my @dumplines = qx(objdump -x $checkfile); for ( @dumplines ) { if( /^\s+DLL Name: (libgcc_|mingwm|libstdc++)(.+\.dll)\s+$/ ) { push @searchfordlls, $1 . $2; } } } my @try = ( @searchfordlls ) ? @searchfordlls : (qw(libgcc_*.dll mingwm10.dll)); my @gccdlls; foreach my $d ( @try ) { my $dll_from = $self->awx_path_search( $d ); if( defined $dll_from ) { my $dll = File::Basename::basename( $dll_from ); push @gccdlls, [ $dll_from, $dll ]; } } if(!@gccdlls) { # check for special case ActivePerl mingw 3.4 PPM my $ppmmingw = qq($Config{sitearch}/auto/MinGW/bin/mingwm10.dll); if( -f $ppmmingw ) { my $dll = File::Basename::basename( $ppmmingw ); push @gccdlls, [ $ppmmingw, $dll ]; } } my %returnfiles = $self->SUPER::files_to_install(); for( @gccdlls ) { $returnfiles{$_->[0]} = awx_arch_file( "rEpLaCe/lib/$_->[1]" ); } print qq(MinGW gcc libs - none found\n) if !@gccdlls; return %returnfiles; } sub awx_strip_dlls { my( $self ) = @_; my( $dir ) = grep !/Config/, bsd_glob( awx_arch_dir( '*' ) ); $self->_system( "attrib -r $dir\\lib\\*.dll" ); $self->_system( "strip $dir\\lib\\*.dll" ); $self->_system( "attrib +r $dir\\lib\\*.dll" ); } 1; Alien-wxWidgets-0.69/inc/My/Build/Win32_MinGW_Bakefile.pm000664000000000000 602612313677352 23450 0ustar00unknownunknown000000000000package My::Build::Win32_MinGW_Bakefile; use strict; use base qw(My::Build::Win32_MinGW My::Build::Win32_Bakefile); use My::Build::Utility qw(awx_install_arch_file awx_install_arch_auto_file); use Config; use Fatal qw(chdir); sub awx_wx_config_data { My::Build::Win32::_init(); my $self = shift; return $self->{awx_data} if $self->{awx_data}; my %data = ( %{$self->SUPER::awx_wx_config_data}, 'cxx' => 'g++', 'ld' => 'g++', ); my $cflags = 'CXXFLAGS=" -Os -DNO_GCC_PRAGMA "'; my $final = $self->awx_debug ? 'BUILD=debug' : 'BUILD=release'; if( my $xbuildflags = $self->awx_w32_extra_buildflags ) { $final .= ' ' . $xbuildflags; } my $unicode = $self->awx_unicode ? 'UNICODE=1' : 'UNICODE=0'; $unicode .= ' MSLU=1' if $self->awx_mslu; my $dir = Cwd::cwd; my $make = $self->_find_make; chdir File::Spec->catdir( $ENV{WXDIR}, 'samples', 'minimal' ); # help xcomp tools local $ENV{GNUTARGET} = ( $Config{ptrsize} == 8 ) ? 'pe-x86-64' : 'pe-i386'; my @t = qx($make -n -B -f makefile.gcc $final $unicode $cflags SHARED=1); my( $orig_libdir, $libdir, $digits ); foreach ( @t ) { chomp; if( m/\s-l\w+/ ) { m/-lwxbase(\d+)/ and $digits = $1; s/^[cg]\+\+//; s/(?:\s|^)-[co]//g; s/\s+\S+\.(exe|o)/ /gi; s{-L(\S+)} {$orig_libdir = File::Spec->canonpath ( File::Spec->rel2abs( $1 ) ); '-L' . ( $libdir = awx_install_arch_file( $self, 'rEpLaCe/lib' ) )}eg; $data{libs} = $_; } elsif( s/^\s*g\+\+\s+// ) { s/\s+\S+\.(cpp|o|d)/ /g; s/\s+-M[DP]\b/ /g; s/(?:\s|^)-[co]//g; s{[-/]I(\S+)}{'-I' . File::Spec->canonpath ( File::Spec->rel2abs( $1 ) )}egi; s{[-/]I(\S+)[\\/]samples[\\/]minimal(\s|$)}{-I$1\\contrib\\include }i; s{[-/]I(\S+)[\\/]samples(\s|$)}{ }i; $data{cxxflags} = $_; } } chdir $dir; die 'Could not find wxWidgets lib directory' unless $libdir; $self->awx_w32_find_setup_dir( $data{cxxflags} ); # for awx_grep_dlls $data{dlls} = $self->awx_grep_dlls( $orig_libdir, $digits, $self->awx_is_monolithic ); $data{w32builtins} = $self->{w32builtins}; $data{version} = $digits; $self->{awx_data} = \%data; } sub _make_command { my $make = $_[0]->_find_make; "$make -f makefile.gcc all " } sub build_wxwidgets { my( $self ) = shift; $self->My::Build::Win32_Bakefile::build_wxwidgets( @_ ); } sub awx_w32_ldflags { my $self = shift; my $ldflags = ( $Config{ptrsize} == 8 ) ? ' -m64' : ' -m32'; return $ldflags; } sub awx_w32_cppflags { my $self = shift; my $cppflags = ( $Config{ptrsize} == 8 ) ? '-m64' : '-m32'; for ( qw( -D_USE_32BIT_TIME_T ) ) { $cppflags .= qq( $_) if $Config{ccflags} =~ /$_/; } return $cppflags; } 1; Alien-wxWidgets-0.69/inc/My/Build/gmake.mak000664000000000000 165512306621537 21142 0ustar00unknownunknown000000000000############################################################################# ## Name: build/Wx/build/Config/gmake.mak ## Purpose: extracts some flag information from makeg95.env ## Author: Mattia Barbon ## Modified by: ## Created: 10/12/2000 ## RCS-ID: $Id: gmake.mak,v 1.1 2005/08/16 20:52:34 mbarbon Exp $ ## Copyright: (c) 2000 Mattia Barbon ## Licence: This program is free software; you can redistribute it and/or ## modify it under the same terms as Perl itself ############################################################################# WXUSINGDLL=1 include $(WXWIN)/src/makeg95.env version: echo $(WXVERSION)$(wxRELEASE_NUMBER) wxdir: echo $(WXWIN) # for 2.4.0 or less vs. 2.4.1 and 2.5.0 cxxflags: echo $(CPPFLAGS) $(ALL_CPPFLAGS) $(ALL_CXXFLAGS) linkflags: echo $(LINKFLAGS) libs: echo $(LIBS) # this one is for import library ( not in wx-config ) implib: echo $(WXLIB) Alien-wxWidgets-0.69/inc/My/Build/nmake.mak000664000000000000 160612306621537 21145 0ustar00unknownunknown000000000000############################################################################# ## Name: build/Wx/build/Config/nmake.mak ## Purpose: extracts some flag information from makevc.env ## Author: Mattia Barbon ## Modified by: ## Created: 29/10/2000 ## RCS-ID: $Id: nmake.mak,v 1.1 2005/08/16 20:52:34 mbarbon Exp $ ## Copyright: (c) 2000 Mattia Barbon ## Licence: This program is free software; you can redistribute it and/or ## modify it under the same terms as Perl itself ############################################################################# NOPCH=1 WXUSINGDLL=1 !include $(WXWIN)\src\makevc.env version: echo $(WXVERSION)$(wxRELEASE_NUMBER) wxdir: echo $(WXWIN) cxxflags: echo $(CPPFLAGS) -D__WXMSW__ linkflags: echo $(LINKFLAGS) libs: echo $(LIBS) # this one is for import library ( not in wx-config ) implib: echo $(WXLIB) Alien-wxWidgets-0.69/inc/bin000775000000000000 013075252612 16340 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/bin/patch000775000000000000 13764212306621540 17575 0ustar00unknownunknown000000000000#!/usr/bin/perl -w eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell # patch - apply a diff file to an original # # mail tgy@chocobo.org < bug_reports # # Copyright (c) 1999 Moogle Stuffy Software. All rights reserved. # # You may play with this software in accordance with the Perl Artistic License. use strict; my $VERSION = '0.25'; $|++; if (@ARGV && $ARGV[0] eq '-v') { print split /^ /m, qq[ This is patch $VERSION written in Perl. Copyright (c) 1999 Moogle Stuffy Software. All rights reserved. You may play with this software in accordance with the Perl Artistic License. ]; exit; } my ($patchfile, @options); if (@ARGV) { require Getopt::Long; Getopt::Long::Configure(qw/ bundling no_ignore_case /); # List of supported options and acceptable arguments. my @desc = qw/ suffix|b=s force|f reject-file|r=s prefix|B=s batch|t reverse|R context|c fuzz|F=i silent|quiet|s check|C ignore-whitespace|l skip|S directory|d=s normal|n unified|u ifdef|D=s forward|N version|v ed|e output|o=s version-control|V=s remove-empty-files|E strip|p=i debug|x=i /; # Each patch may have its own set of options. These are separated by # a '+' on the command line. my @opts; for (@ARGV, '+') { # Now '+' terminated instead of separated... if ($_ eq '+') { push @options, [splice @opts, 0]; } else { push @opts, $_; } } # Parse each set of options into a hash. my $next = 0; for (@options) { local @ARGV = @$_; Getopt::Long::GetOptions(\my %opts, @desc); $opts{origfile} = shift; $_ = \%opts; $patchfile = shift unless $next++; } } $patchfile = '-' unless defined $patchfile; my $patch = Patch->new(@options); tie *PATCH, Pushback => $patchfile or die "Can't open '$patchfile': $!"; # Extract patches from patchfile. We unread/pushback lines by printing to # the PATCH filehandle: 'print PATCH' PATCH: while () { if (/^(\s*)(\@\@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? \@\@\n)/) { # UNIFIED DIFF my ($space, $range, $i_start, $i_lines, $o_start, $o_lines) = ($1, $2, $3, $4 || 1, $5, $6 || 1); $patch->bless('unified') or next PATCH; my @hunk; my %saw = map {$_, 0} split //, ' +-'; my $re = qr/^$space([ +-])/; while () { unless (s/$re/$1/) { $patch->note("Short hunk ignored.\n"); $patch->reject($range, @hunk); print PATCH; next PATCH; } push @hunk, $_; $saw{$1}++; last if $saw{'-'} + $saw{' '} == $i_lines && $saw{'+'} + $saw{' '} == $o_lines; } $patch->apply($i_start, $o_start, @hunk) or $patch->reject($range, @hunk); } elsif (/^(\s*)\*{15}$/) { # CONTEXT DIFF my $space = $1; $_ = ; unless (/^$space(\*\*\* (\d+)(?:,(\d+))? \*\*\*\*\n)/) { print PATCH; next PATCH; } my ($i_range, $i_start, $i_end, @i_hunk) = ($1, $2, $3 || $2); my ($o_range, $o_start, $o_end, @o_hunk); $patch->bless('context') or next PATCH; my $o_hunk = qr/^$space(--- (\d+)(?:,(\d+))? ----\n)/; my $re = qr/^$space([ !-] )/; $_ = ; if (/$o_hunk/) { ($o_range, $o_start, $o_end) = ($1, $2, $3 || $2); } else { print PATCH; for ($i_start..$i_end) { $_ = ; unless (s/$re/$1/) { $patch->note("Short hunk ignored.\n"); $patch->reject($i_range, @i_hunk); print PATCH; next PATCH; } push @i_hunk, $_; } $_ = ; unless (/$o_hunk/) { $patch->note("Short hunk ignored...no second line range.\n"); $patch->reject($i_range, @i_hunk); print PATCH; next PATCH; } ($o_range, $o_start, $o_end) = ($1, $2, $3 || $2); } $re = qr/^$space([ !+] )/; $_ = ; if (/^$space\*{15}$/) { print PATCH; } else { print PATCH; for ($o_start..$o_end) { $_ = ; unless (s/$re/$1/) { $patch->note("Short hunk ignored.\n"); $patch->reject($i_range, @i_hunk, $o_range, @o_hunk); print PATCH; next PATCH; } push @o_hunk, $_; } } $patch->apply($i_start, $o_start, \@i_hunk, \@o_hunk) or $patch->reject($i_range, @i_hunk, $o_range, @o_hunk); } elsif (/^(\s*)((\d+)(?:,(\d+))?([acd])(\d+)(?:,(\d+))?\n)/) { # NORMAL DIFF my ($space, $range, $i_start, $i_end, $cmd, $o_start, $o_end) = ($1, $2, $3, $4 || $3, $5, $6, $7 || $6); $patch->bless('normal') or next PATCH; my (@d_hunk, @a_hunk); my $d_re = qr/^$space< /; my $a_re = qr/^$space> /; if ($cmd eq 'c' || $cmd eq 'd') { for ($i_start..$i_end) { $_ = ; unless (s/$d_re//) { $patch->note("Short hunk ignored.\n"); $patch->reject($range, @d_hunk); print PATCH; next PATCH; } push @d_hunk, $_; } } if ($cmd eq 'c') { $_ = ; unless ($_ eq "---\n") { $patch->note("Short hunk ignored...no '---' separator.\n"); $patch->reject($range, @d_hunk); print PATCH; next PATCH; } } if ($cmd eq 'c' || $cmd eq 'a') { for ($o_start..$o_end) { $_ = ; unless (s/$a_re//) { $patch->note("Short hunk ignored.\n"); $patch->reject($range, @d_hunk, "---\n", @a_hunk); print PATCH; next PATCH; } push @a_hunk, $_; } } $patch->apply($i_start, $o_start, $cmd, \@d_hunk, \@a_hunk) or $patch->reject($range, @d_hunk, "---\n", @a_hunk); } elsif (/^(\s*)\d+(?:,\d+)?[acd]$/) { # ED SCRIPT my $space = qr/^$1/; $patch->bless('ed') or next PATCH; print PATCH; my @cmd; ED: while () { unless (s/$space// && m!^\d+(?:,\d+)?([acd]|s\Q/^\.\././\E)$!) { print PATCH; last ED; } push @cmd, [$_]; $1 =~ /^[ac]$/ or next; while () { unless (s/$space//) { print PATCH; last ED; } push @{$cmd[-1]}, $_; last if /^\.$/; } } $patch->apply(@cmd) or $patch->reject(map @$_, @cmd); } else { # GARBAGE $patch->garbage($_); } } close PATCH; if (ref $patch eq 'Patch') { $patch->note("Hmm... I can't seem to find a patch in there anywhere.\n"); } else { $patch->end; } $patch->note("done\n"); exit $patch->error ? 1 : 0; END { close STDOUT || die "$0: can't close stdout: $!\n"; $? = 1 if $? == 255; # from die } package Patch; use vars qw/$ERROR/; # Class data. BEGIN { $ERROR = 0; } sub import { no strict 'refs'; *{caller() . '::throw'} = \&throw; @{caller() . '::ISA'} = 'Patch'; } # Simple throw/catch error handling. sub throw { $@ = join '', @_; $@ .= sprintf " at %s line %d\n", (caller)[1..2] unless $@ =~ /\n\z/; goto CATCH; } # Prints a prompt message and returns response. sub prompt { print @_; local $_ = ; chomp; $_; } # Constructs a Patch object. sub new { my $class = shift; my %copy = %{$_[0]} if ref $_[0]; bless { %copy, options => [@_], garbage => [], rejects => [], }, $class; } # Blesses object into a subclass. sub bless { my $type = pop; my $class = "Patch::\u$type"; my ($options, $garbage) = @{$_[0]}{'options', 'garbage'}; # New hunk, same patch. $_[0]{hunk}++, return 1 if $_[0]->isa($class) && ! @$garbage; # Clean up previous Patch object first. $_[0]->end; # Get options/switches for new patch. my $self = @$options > 1 ? shift @$options : @$options == 1 ? { %{$options->[0]} } : {}; bless $self, $class; # 'options' and 'garbage' are probably better off as class # data. Why didn't I do that before? But it's not broken # so I'm not fixing it. $self->{options} = $options; # @options $self->{garbage} = []; # garbage lines $self->{i_pos} = 0; # current position in 'in' file $self->{o_pos} = 0; # just for symmetry $self->{i_lines} = 0; # lines read in 'in' file $self->{o_lines} = 0; # lines written to 'out' file $self->{hunk} = 1; # current hunk number $self->{rejects} = []; # save rejected hunks here $self->{fuzz} = 2 unless defined $self->{fuzz} && $self->{fuzz} >= 0; $self->{ifdef} = '' unless defined $self->{ifdef}; # Skip patch? $self->{skip} and $self->skip; # -c, -e, -n, -u $self->{$_} and $type eq $_ || $self->skip("Not a $_ diff!\n") for qw/context ed normal unified/; # Speculate to user. my $n = $type eq 'ed' ? 'n' : ''; $self->note("Hmm... Looks like a$n $type diff to me...\n"); # Change directories. for ($self->{directory}) { defined or last; chdir $_ or $self->skip("Can't chdir '$_': $!\n"); } # Get original file to patch... my $orig = $self->{origfile}; # ...from -o unless (defined $orig) { $orig = $self->rummage($garbage); # ...from leading garbage if (defined $orig) { $self->note( "The text leading up to this was:\n", "--------------------------\n", map("|$_", @$garbage), "--------------------------\n", ); } else { $self->skip if $self->{force} || $self->{batch}; $orig = prompt ('File to patch: '); # ...from user } } # Make sure original file exists. if ($self->{force} || $self->{batch}) { -e $orig or $self->skip; } else { until (-e $orig) { $self->skip unless prompt ( 'No file found--skip this patch? [n] ' ) =~ /^[yY]/; $orig = prompt ( 'File to patch: ' ); } } my ($in, $out); # Create backup file. I have no clue what Plan A is really supposed to be. if ($self->{check}) { $self->note("Checking patch against file $orig using Plan C...\n"); ($in, $out) = ($orig, ''); } elsif (defined $self->{output}) { $self->note("Patching file $orig using Plan T...\n"); local $_ = $self->{output}; $self->skip if -e && not rename $_, $self->backup($_) and $self->{force} || $self->{batch} || prompt ( 'Failed to backup output file--skip this patch? [n] ' ) =~ /^[yY]/; ($in, $out) = ($orig, $self->{output}); } else { $self->note("Patching file $orig using Plan A...\n"); my $back = $self->backup($orig); if (rename $orig, $back) { ($in, $out) = ($back, $orig); } else { $self->skip unless $self->{force} || $self->{batch} or prompt ( 'Failed to backup original file--skip this patch? [n] ' ) !~ /^[yY]/; ($in, $out) = ($orig, $orig); } } # Open original file. local *IN; open IN, "< $in" or $self->skip("Couldn't open INFILE: $!\n"); binmode IN; $self->{i_fh} = *IN; # input filehandle $self->{i_file} = $in; # input filename # Like /dev/null local *NULL; tie *NULL, 'Dev::Null'; # Open output file. if ($self->{check}) { $self->{o_fh} = \*NULL; # output filehandle $self->{d_fh} = \*NULL; # ifdef filehandle } else { local *OUT; open OUT, "+> $out" or $self->skip("Couldn't open OUTFILE: $!\n"); binmode OUT; $|++, select $_ for select OUT; $self->{o_fh} = *OUT; $self->{o_file} = $out; $self->{d_fh} = length $self->{ifdef} ? *OUT : \*NULL; } $self->{'reject-file'} = "$out.rej" unless defined $self->{'reject-file'}; # Check for 'Prereq:' line. unless ($self->{force}) { my $prereq = (map /^Prereq:\s*(\S+)/, @$garbage)[-1]; if (defined $prereq) { $prereq = qr/\b$prereq\b/; my $found; while () { $found++, last if /$prereq/; } seek IN, 0, 0 or $self->skip("Couldn't seek INFILE: $!\n"); $self->skip if not $found and $self->{batch} || prompt ( 'File does not match "Prereq: $1"--skip this patch? [n] ' ) =~ /^[yY]/; } } SKIP: $_[0] = $self; } # Skip current patch. sub skip { my $self = shift; $self->note(@_) if @_; $self->note("Skipping patch...\n"); $self->{skip}++; goto SKIP; } # Let user know what's happening. sub note { my $self = shift; print @_ unless $self->{silent} || $self->{skip}; } # Add to lines of leading garbage. sub garbage { push @{shift->{garbage}}, @_; } # Add to rejected hunks. sub reject { push @{shift->{rejects}}, [@_]; } # Total number of hunks rejected. sub error { $ERROR; } # End of patch clean up. sub end { my $self = shift; return if $self->{skip} || ref $self eq 'Patch'; $self->print_tail; $self->print_rejects; $self->remove_empty_files; } # Output any lines left in input handle. sub print_tail { my $self = shift; print {$self->{o_fh}} readline $self->{i_fh}; } # Output rejected hunks to reject file. sub print_rejects { my $self = shift; my @rej = @{$self->{rejects}}; $ERROR += @rej; @rej or return; $self->note( @rej . " out of $self->{hunk} hunks ignored--saving rejects to ", "$self->{'reject-file'}\n\n" ); if (open REJ, "> $self->{'reject-file'}") { print REJ map @$_, @rej; close REJ; } else { $self->note("Couldn't open reject file: $!\n"); } } # Remove empty files... d'uh sub remove_empty_files { my $self = shift; $self->{'remove-empty-files'} or return; close $self->{o_fh}; defined && -z and $self->note( unlink($_) ? "Removed empty file '$_'.\n" : "Can't remove empty file '$_': $!\n" ) for $self->{o_file}; } # Go through leading garbage looking for name of file to patch. sub rummage { my ($self, $garbage) = @_; for (reverse @$garbage) { /^Index:\s*(\S+)/ or next; my $file = $self->strip($1); -e $file or next; return $file; } return; } # Strip slashes from path. sub strip { my $self = shift; my $path = shift; $path = $_ unless defined $path; local $^W; if (not exists $self->{strip}) { unless ($path =~ m!^/!) { $path =~ m!^(.*/)?(.+)$!; $path = $2 unless -e $1; } } elsif ($self->{strip} > 0) { my $i = $self->{strip}; $path =~ s![^/]*/!! while $i--; } $path; } # Create a backup file from options. sub backup { my ($self, $file) = @_; $file = $self->{prefix} ? "$self->{prefix}$file" : $self->{'version-control'} ? $self->version_control_backup( $file, $self->{'version-control'}) : $self->{suffix} ? "$file$self->{suffix}" : $ENV{VERSION_CONTROL} ? $self->version_control_backup( $file, $ENV{VERSION_CONTROL}) : $ENV{SIMPLE_BACKUP_SUFFIX} ? "$file$ENV{SIMPLE_BACKUP_SUFFIX}" : "$file.orig"; # long filename my ($name, $extension) = $file =~ /^(.+)(?:\.([^.]+))?$/; my $ext = $extension; while (-e $file) { if ($ext !~ s/[a-z]/\U$1/) { $ext = $extension; $name =~ s/.// or die "Couldn't create a good backup filename.\n"; } $file = $name . $ext; } $file; } # Create a backup file using version control. sub version_control_backup { my ($self, $file, $version) = @_; if ($version =~ /^(?:ne|s)/) { # never|simple $file .= $self->suffix_backup; } else { opendir DIR, '.' or die "Can't open dir '.': $!"; my $re = qr/^\Q$file\E\.~(\d+)~$/; my @files = map /$re/, readdir DIR; close DIR; if (@files) { # version number already exists my $next = 1 + (sort {$a <=> $b} @files)[-1]; $file .= ".~$next~"; } else { # t|numbered # nil|existing $file .= $version =~ /^(?:t|nu)/ ? '.~1~' : $self->suffix_backup; } } $file; } # Create a backup file using suffix. sub suffix_backup { my $self = shift; return $self->{suffix} if $self->{suffix}; return $ENV{SIMPLE_BACKUP_SUFFIX} if $ENV{SIMPLE_BACKUP_SUFFIX}; return '.orig'; } # Apply a patch hunk. The default assumes a unified diff. sub apply { my ($self, $i_start, $o_start, @hunk) = @_; $self->{skip} and throw 'SKIP...ignore this patch'; if ($self->{reverse}) { my $not = { qw/ + - - + / }; s/^([+-])/$not->{$1}/ for @hunk; } my @context = map /^[ -](.*)/s, @hunk; my $position; my $fuzz = 0; if (@context) { # Find a place to apply hunk where context matches. for (0..$self->{fuzz}) { my ($pos, $lines) = ($self->{i_pos}, 0); while (1) { ($pos, $lines) = $self->index(\@context, $pos, $lines) or last; my $line = $self->{i_lines} + $lines + 1; if ($line >= $i_start) { my $off = $line - $i_start; $position = [$lines, $off] unless $position && $position->[-1] < $off; last; } $position = [$lines, $i_start - $line]; $pos++, $lines = 1; } last if $position; last unless $hunk[0] =~ /^ / && shift @hunk or $hunk[-1] =~ /^ / && pop @hunk; @context = map /^[ -](.*)/s, @hunk or last; $fuzz++; } # If there's nowhere to apply the first hunk, we check if it is # a reversed patch. if ($self->{hunk} == 1) { if ($self->{reverse_check}) { $self->{reverse_check} = 0; if ($position) { unless ($self->{batch}) { local $_ = prompt ( 'Reversed (or previously applied) patch detected!', ' Assume -R? [y] ' ); if (/^[nN]/) { $self->{reverse} = 0; $position = 0; prompt ('Apply anyway? [n] ') =~ /^[yY]/ or throw 'SKIP...ignore this patch'; } } } else { throw 'SKIP...ignore this patch' if $self->{forward}; } } else { unless ($position || $self->{reverse} || $self->{force}) { $self->{reverse_check} = 1; $self->{reverse} = 1; shift; return $self->apply(@_); } } } $position or throw "Couldn't find anywhere to put hunk.\n"; } else { # No context. Use given position. $position = [$i_start - $self->{i_lines} - 1] } my $in = $self->{i_fh}; my $out = $self->{o_fh}; my $def = $self->{d_fh}; my $ifdef = $self->{ifdef}; # Make sure we're where we left off. seek $in, $self->{i_pos}, 0 or throw "Couldn't seek INFILE: $!"; my $line = $self->{o_lines} + $position->[0] + 1; my $off = $line - $o_start; # Set to new position. $self->{i_lines} += $position->[0]; $self->{o_lines} += $position->[0]; print $out scalar <$in> while $position->[0]--; # Apply hunk. my $was = ' '; for (@hunk) { /^([ +-])(.*)/s; my $cmd = substr $_, 0, 1, ''; if ($cmd eq '-') { $cmd eq $was or print $def "#ifndef $ifdef\n"; print $def scalar <$in>; $self->{i_lines}++; } elsif ($cmd eq '+') { $cmd eq $was or print $def $was eq ' ' ? "#ifdef $ifdef\n" : "#else\n"; print $out $_; $self->{o_lines}++; } else { $cmd eq $was or print $def "#endif /* $ifdef */\n"; print $out scalar <$in>; $self->{i_lines}++; $self->{o_lines}++; } $was = $cmd; } $was eq ' ' or print $def "#endif /* $ifdef */\n"; # Keep track of where we leave off. $self->{i_pos} = tell $in; # Report success to user. $self->note("Hunk #$self->{hunk} succeeded at $line.\n"); $self->note(" Offset: $off\n") if $off; $self->note(" Fuzz: $fuzz\n") if $fuzz; return 1; # Or report failure. CATCH: $self->{skip}++ if $@ =~ /^SKIP/; $self->note( $self->{skip} ? "Hunk #$self->{hunk} ignored at $o_start.\n" : "Hunk #$self->{hunk} failed--$@" ); return; } # Find where an array of lines matches in a file after a given position. # $match => [array of lines] # $pos => search after this position and... # $lines => ...after this many lines after $pos # Returns the position of the match and the number of lines between the # starting and matching positions. sub index { my ($self, $match, $pos, $lines) = @_; my $in = $self->{i_fh}; seek $in, $pos, 0 or throw "Couldn't seek INFILE [$in, 0, $pos]: $!"; <$in> while $lines--; if ($self->{'ignore-whitespace'}) { s/\s+/ /g for @$match; } my $tell = tell $in; my $line = 0; while (<$in>) { s/\s+/ /g if $self->{'ignore-whitespace'}; if ($_ eq $match->[0]) { my $fail; for (1..$#$match) { my $line = <$in>; $line =~ s/\s+/ /g if $self->{'ignore-whitespace'}; $line eq $match->[$_] or $fail++, last; } if ($fail) { seek $in, $tell, 0 or throw "Couldn't seek INFILE: $!"; <$in>; } else { return ($tell, $line); } } $line++; $tell = tell $in; } return; CATCH: $self->note($@), return; } package Patch::Context; BEGIN { Patch->import } # Convert hunk to unified diff, then apply. sub apply { my ($self, $i_start, $o_start, $i_hunk, $o_hunk) = @_; my @hunk; my @i_hunk = @$i_hunk; my @o_hunk = @$o_hunk; s/^(.) /$1/ for @i_hunk, @o_hunk; while (@i_hunk and @o_hunk) { my ($i, $o) = (shift @i_hunk, shift @o_hunk); if ($i eq $o) { push @hunk, $i; next; } while ($i =~ s/^[!-]/-/) { push @hunk, $i; $i = shift @i_hunk; } while ($o =~ s/^[!+]/+/) { push @hunk, $o; $o = shift @o_hunk; } push @hunk, $i; } push @hunk, @i_hunk, @o_hunk; $self->SUPER::apply($i_start, $o_start, @hunk); } # Check for filename in diff header, then in 'Index:' line. sub rummage { my ($self, $garbage) = @_; my @files = grep -e, map $self->strip, map /^\s*(?:\*\*\*|---) (\S+)/, @$garbage[-1, -2]; my $file = @files == 1 ? $files[0] : @files == 2 ? $files[length $files[0] > length $files[1]] : $self->SUPER::rummage($garbage); return $file; } package Patch::Ed; BEGIN { Patch->import } # Pipe ed script to ed or try to manually process. sub apply { my ($self, @cmd) = @_; $self->{skip} and throw 'SKIP...ignore this patch'; my $out = $self->{o_fh}; $self->{check} and goto PLAN_J; # We start out by adding a magic line to our output. If this line # is still there after piping to ed, then ed failed. We do this # because win32 will silently fail if there is no ed program. my $magic = "#!/i/want/a/moogle/stuffy\n"; print $out $magic; # Pipe to ed. eval { local $SIG{PIPE} = sub { die 'Pipe broke...' }; local $SIG{CHLD} = sub { die 'Bad child...' }; open ED, "| ed - -s $self->{i_file}" or die "Couldn't fork ed: $!"; print ED map @$_, @cmd or die "Couldn't print ed: $!"; print ED "1,\$w $self->{o_file}" or die "Couldn't print ed: $!"; close ED or die "Couldn't close ed: $?"; }; # Did pipe to ed work? unless ($@ or <$out> ne $magic) { $self->note("Hunk #$self->{hunk} succeeded at 1.\n"); return 1; } # Erase any trace of magic line. truncate $out, 0 or throw "Couldn't truncate OUT: $!"; seek $out, 0, 0 or throw "Couldn't seek OUT: $!"; # Try to apply ed script by hand. $self->note("Pipe to ed failed. Switching to Plan J...\n"); PLAN_J: # Pre-process each ed command. Ed diffs are reversed (so that each # command doesn't end up changing the line numbers of subsequent # commands). But we need to apply diffs in a forward direction because # our filehandles are oriented that way. So we calculate the @offset # in line number that this will cause as we go. my @offset; for (my $i = 0; $i < @cmd; $i++) { my @hunk = @{$cmd[$i]}; shift(@hunk) =~ m!^(\d+)(?:,(\d+))?([acds])! or throw "Unable to parse ed script."; my ($start, $end, $cmd) = ($1, $2 || $1, $3); # We don't parse substitution commands and assume they all mean # s/\.\././ even if they really mean s/\s+// or such. And we # blindly apply the command to the previous hunk. if ($cmd eq 's') { $cmd[$i] = ''; s/\.\././ for @{$cmd[$i-1][3]}; next; } # Remove '.' line used to terminate hunks. pop @hunk if $cmd =~ /^[ac]/; # Calculate where we actually start and end by removing any offsets. my ($s, $e) = ($start, $end); for (@offset) { $start > $_->[0] or next; $s -= $_->[1]; $e -= $_->[1]; } # Add to the total offset. push @offset, [$start, map { /^c/ ? scalar @hunk - ($end + 1 - $start) : /^a/ ? scalar @hunk : /^d/ ? $end + 1 - $start : 0 } $cmd]; # Post-processed command. $cmd[$i] = [$s, $e, $cmd, \@hunk, $i]; } # Sort based on calculated start positions or on original order. # Substitution commands have already been applied and are ignored. @cmd = sort { $a->[0] <=> $b->[0] || $a->[-1] <=> $b->[-1] } grep ref, @cmd; my $in = $self->{i_fh}; my $def = $self->{d_fh}; my $ifdef = $self->{ifdef}; # Apply each command. for (@cmd) { my ($start, $end, $cmd, $hunk) = @$_; if ($cmd eq 'a') { my $diff = $start - $self->{i_lines}; print $out scalar <$in> while $diff--; print $def "#ifdef $ifdef\n"; print $out @$hunk; $self->{i_lines} = $start; } elsif ($cmd eq 'd') { my $diff = $start - $self->{i_lines} - 1; print $out scalar <$in> while $diff--; print $def "#ifndef $ifdef\n"; print $def scalar <$in> for $start..$end; $self->{i_lines} = $end; } elsif ($cmd eq 'c') { my $diff = $start - $self->{i_lines} - 1; print $out scalar <$in> while $diff--; print $def "#ifndef $ifdef\n"; print $def scalar <$in> for $start..$end; print $def "#else\n"; print $out @$hunk; $self->{i_lines} = $end; } print $def "#endif /* $ifdef */\n"; } # Output any lines left in input handle. print $out readline $in; # Report success to user. for (my $i = 0; $i < @cmd; $i++) { $self->note( 'Hunk #', $i+1, ' succeeded at ', $cmd[$i - not ref $cmd[$i]][0], "\n", ); } return 1; # Or report failure. CATCH: $self->{skip}++ if $@ =~ /^SKIP/; $self->note( $self->{skip} ? "Hunk #$self->{hunk} ignored at 1.\n" : "Hunk #$self->{hunk} failed--$@" ); return; } # End of patch clean up. $self->print_tail is omitted because ed diffs are # applied all at once rather than one hunk at a time. sub end { my $self = shift; return if $self->{skip}; $self->print_rejects; $self->remove_empty_files; } package Patch::Normal; BEGIN { Patch->import } # Convert hunk to unified diff, then apply. sub apply { my ($self, $i_start, $o_start, $cmd, $d_hunk, $a_hunk) = @_; $i_start++ if $cmd eq 'a'; $o_start++ if $cmd eq 'd'; my @hunk; push @hunk, map "-$_", @$d_hunk; push @hunk, map "+$_", @$a_hunk; $self->SUPER::apply($i_start, $o_start, @hunk); } package Patch::Unified; BEGIN { Patch->import } # Check for filename in diff header, then in 'Index:' line. sub rummage { my ($self, $garbage) = @_; my @files = grep -e, map $self->strip, map /^\s*(?:---|\+\+\+) (\S+)/, @$garbage[-1, -2]; my $file = @files == 1 ? $files[0] : @files == 2 ? $files[length $files[0] > length $files[1]] : $self->SUPER::rummage($garbage); return $file; } package Pushback; # Create filehandles that can unread or push lines back into queue. sub TIEHANDLE { my ($class, $file) = @_; local *FH; open *FH, "< $file" or return; binmode FH; bless [*FH], $class; } sub READLINE { my $self = shift; @$self == 1 ? readline $self->[0] : pop @$self; } sub PRINT { my $self = shift; $self->[1] = shift; } sub CLOSE { my $self = shift; $self = undef; } package Dev::Null; # Create filehandles that go nowhere. sub TIEHANDLE { bless \my $null } sub PRINT {} sub PRINTF {} sub WRITE {} sub READLINE {''} sub READ {''} sub GETC {''} __END__ =head1 NAME patch - apply a diff file to an original =head1 SYNOPSIS B [options] [origfile [patchfile]] [+ [options] [origfile]]... but usually just B Epatchfile =head1 DESCRIPTION I will take a patch file containing any of the four forms of difference listing produced by the I program and apply those differences to an original file, producing a patched version. By default, the patched version is put in place of the original, with the original file backed up to the same name with the extension ".orig" [see L<"note 1">], or as specified by the B<-b>, B<-B>, or B<-V> switches. The extension used for making backup files may also be specified in the BI<_>BI<_>B environment variable, which is overridden by above switches. If the backup file already exists, B creates a new backup file name by changing the first lowercase letter in the last component of the file's name into uppercase. If there are no more lowercase letters in the name, it removes the first character from the name. It repeats this process until it comes up with a backup file that does not already exist. You may also specify where you want the output to go with a B<-o> switch; if that file already exists, it is backed up first. If I is omitted, or is a hyphen, the patch will be read from standard input. Upon startup, patch will attempt to determine the type of the diff listing, unless over-ruled by a B<-c>, B<-e>, B<-n>, or B<-u> switch. Context diffs [see L<"note 2">], unified diffs, and normal diffs are applied by the I program itself, while ed diffs are simply fed to the I editor via a pipe [see L<"note 3">]. I will try to skip any leading garbage, apply the diff, and then skip any trailing garbage. Thus you could feed an article or message containing a diff listing to I, and it should work. If the entire diff is indented by a consistent amount, this will be taken into account. With context diffs, and to a lesser extent with normal diffs, I can detect when the line numbers mentioned in the patch are incorrect, and will attempt to find the correct place to apply each hunk of the patch. A linear search is made for a place where all lines of the context match. The hunk is applied at the place nearest the line number mentioned in the diff [see L<"note 4">]. If no such place is found, and it's a context diff, and the maximum fuzz factor is set to 1 or more, then another scan takes place ignoring the first and last line of context. If that fails, and the maximum fuzz factor is set to 2 or more, the first two and last two lines of context are ignored, and another scan is made. (The default maximum fuzz factor is 2.) If I cannot find a place to install that hunk of the patch, it will put the hunk out to a reject file, which normally is the name of the output file plus ".rej" [see L<"note 1">]. The format of the rejected hunk remains unchanged [see L<"note 5">]. As each hunk is completed, you will be told whether the hunk succeeded or failed, and which line (in the new file) I thought the hunk should go on. If this is different from the line number specified in the diff you will be told the offset. A single large offset MAY be an indication that a hunk was installed in the wrong place. You will also be told if a fuzz factor was used to make the match, in which case you should also be slightly suspicious. If no original file is specified on the command line, I will try to figure out from the leading garbage what the name of the file to edit is. In the header of a context diff, the filename is found from lines beginning with "***" or "---", with the shortest name of an existing file winning. Only context diffs have lines like that, but if there is an "Index:" line in the leading garbage, I will try to use the filename from that line. The context diff header takes precedence over an Index line. If no filename can be intuited from the leading garbage, you will be asked for the name of the file to patch. No attempt is made to look up SCCS or RCS files [see L<"note 6">]. Additionally, if the leading garbage contains a "Prereq: " line, I will take the first word from the prerequisites line (normally a version number) and check the input file to see if that word can be found. If not, I will ask for confirmation before proceeding. The upshot of all this is that you should be able to say, while in a news interface, the following: | patch -d /usr/src/local/blurfl and patch a file in the blurfl directory directly from the article containing the patch. If the patch file contains more than one patch, I will try to apply each of them as if they came from separate patch files. This means, among other things, that it is assumed that the name of the file to patch must be determined for each diff listing, and that the garbage before each diff listing will be examined for interesting things such as filenames and revision level, as mentioned previously. You can give switches (and another original file name) for the second and subsequent patches by separating the corresponding argument lists by a '+'. (The argument list for a second or subsequent patch may not specify a new patch file, however.) I recognizes the following switches: =over =item -b or --suffix causes the next argument to be interpreted as the backup extension, to be used in place of ".orig" [see L<"note 1">]. =item -B or --prefix causes the next argument to be interpreted as a prefix to the backup file name. If this argument is specified any argument from -b will be ignored. =item -c or --context forces I to interpret the patch file as a context diff. =item -C or --check checks that the patch would apply cleanly, but does not modify anything. =item -d or --directory causes I to interpret the next argument as a directory, and cd to it before doing anything else. =item -D or --ifdef causes I to use the "#ifdef...#endif" construct to mark changes. The argument following will be used as the differentiating symbol. [see L<"note 7">] =item -e or --ed forces I to interpret the patch file as an ed script. =item -E or --remove-empty-files causes I to remove output files that are empty after the patches have been applied. =item -f or --force forces I to assume that the user knows exactly what he or she is doing, and to not ask any questions. It assumes the following: skip patches for which a file to patch can't be found; patch files even though they have the wrong version for the ``Prereq:'' line in the patch; and assume that patches are not reversed even if they look like they are. This option does not suppress commentary; use B<-s> for that. =item -t or --batch similar to B<-f>, in that it suppresses questions, but makes some different assumptions: skip patches for which a file to patch can't be found (the same as B<-f>); skip patches for which the file has the wrong version for the ``Prereq:'' line in the patch; and assume that patches are reversed if they look like they are. =item -Fnumber or --fuzz number sets the maximum fuzz factor. This switch only applies to context diffs, and causes I to ignore up to that many lines in looking for places to install a hunk. Note that a larger fuzz factor increases the odds of a faulty patch. The default fuzz factor is 2, and it may not be set to more than the number of lines of context in the context diff, ordinarily 3. =item -l or --ignore-whitespace causes the pattern matching to be done loosely, in case the tabs and spaces have been munged in your input file. Any sequence of whitespace in the pattern line will match any sequence in the input file. Normal characters must still match exactly. Each line of the context must still match a line in the input file. =item -n or --normal forces I to interpret the patch file as a normal diff. =item -N or --forward causes I to ignore patches that it thinks are reversed or already applied. See also B<-R .> =item -o or --output causes the next argument to be interpreted as the output file name. =item -pnumber or --strip number sets the pathname strip count, which controls how pathnames found in the patch file are treated, in case the you keep your files in a different directory than the person who sent out the patch. The strip count specifies how many slashes are to be stripped from the front of the pathname. (Any intervening directory names also go away.) For example, supposing the filename in the patch file was /i/want/a/moogle/stuffy setting B<-p> or B<-p0> gives the entire pathname unmodified, B<-p1> gives i/want/a/moogle/stuff without the leading slash, B<-p4> gives moogle/stuffy and not specifying B<-p> at all just gives you "stuffy", unless all of the directories in the leading path (i/want/a/moogle) exist and that path is relative, in which case you get the entire pathname unmodified. Whatever you end up with is looked for either in the current directory, or the directory specified by the B<-d> switch. =item -r or --reject-file causes the next argument to be interpreted as the reject file name. =item -R or --reverse tells I that this patch was created with the old and new files swapped. (Yes, I'm afraid that does happen occasionally, human nature being what it is.) I will attempt to swap each hunk around before applying it. Rejects will come out in the swapped format. The B<-R> switch will not work with ed diff scripts because there is too little information to reconstruct the reverse operation. If the first hunk of a patch fails, I will reverse the hunk to see if it can be applied that way. If it can, you will be asked if you want to have the B<-R> switch set. If it can't, the patch will continue to be applied normally. (Note: this method cannot detect a reversed patch if it is a normal diff and if the first command is an append (i.e. it should have been a delete) since appends always succeed, due to the fact that a null context will match anywhere. Luckily, most patches add or change lines rather than delete them, so most reversed normal diffs will begin with a delete, which will fail, triggering the heuristic.) =item -s or --quiet or --silent makes I do its work silently, unless an error occurs. =item -S or --skip causes I to ignore this patch from the patch file, but continue on looking for the next patch in the file. Thus patch -S + -S + < patchfile will ignore the first and second of three patches. =item -u or --unified forces I to interpret the patch file as a unified context diff (a unidiff). =item -v or --version causes I to print out its revision header and patch level. =item -V or --version-control causes the next argument to be interpreted as a method for creating backup file names. The type of backups made can also be given in the BI<_>B environment variable, which is overridden by this option. The B<-B> option overrides this option, causing the prefix to always be used for making backup file names. The value of the BI<_>B environment variable and the argument to the B<-V> option are like the GNU Emacs `version-control' variable; they also recognize synonyms that are more descriptive. The valid values are (unique abbreviations are accepted): =over =item `t' or `numbered' Always make numbered backups. =item `nil' or `existing' Make numbered backups of files that already have them, simple backups of the others. This is the default. =item `never' or `simple' Always make simple backups. =back =item -xnumber or --debug number sets internal debugging flags, and is of no interest to I patchers [see L<"note 8">]. =back =head1 ENVIRONMENT BI<_>BI<_>B Extension to use for backup file names instead of ".orig" or "~". BI<_>B Selects when numbered backup files are made. =head1 SEE ALSO diff(1), ed(1) =head1 NOTES FOR PATCH SENDERS There are several things you should bear in mind if you are going to be sending out patches. First, you can save people a lot of grief by keeping a patchlevel.h file which is patched to increment the patch level as the first diff in the patch file you send out. If you put a Prereq: line in with the patch, it won't let them apply patches out of order without some warning. Second, make sure you've specified the filenames right, either in a context diff header, or with an Index: line. If you are patching something in a subdirectory, be sure to tell the patch user to specify a B<-p> switch as needed. Third, you can create a file by sending out a diff that compares a null file to the file you want to create. This will only work if the file you want to create doesn't exist already in the target directory. Fourth, take care not to send out reversed patches, since it makes people wonder whether they already applied the patch. Fifth, while you may be able to get away with putting 582 diff listings into one file, it is probably wiser to group related patches into separate files in case something goes haywire. =head1 DIAGNOSTICS Too many to list here, but generally indicative that I couldn't parse your patch file. The message "Hmm..." indicates that there is unprocessed text in the patch file and that I is attempting to intuit whether there is a patch in that text and, if so, what kind of patch it is. I will exit with a non-zero status if any reject files were created. When applying a set of patches in a loop it behooves you to check this exit status so you don't apply a later patch to a partially patched file. =head1 CAVEATS I cannot tell if the line numbers are off in an ed script, and can only detect bad line numbers in a normal diff when it finds a "change" or a "delete" command. A context diff using fuzz factor 3 may have the same problem. Until a suitable interactive interface is added, you should probably do a context diff in these cases to see if the changes made sense. Of course, compiling without errors is a pretty good indication that the patch worked, but not always. I usually produces the correct results, even when it has to do a lot of guessing. However, the results are guaranteed to be correct only when the patch is applied to exactly the same version of the file that the patch was generated from. =head1 BUGS Could be smarter about partial matches, excessively deviant offsets and swapped code, but that would take an extra pass. Check patch mode ( B<-C>) will fail if you try to check several patches in succession that build on each other. The whole code of I would have to be restructured to keep temporary files around so that it can handle this situation. If code has been duplicated (for instance with #ifdef OLDCODE ... #else ... #endif), I is incapable of patch- ing both versions, and, if it works at all, will likely patch the wrong one, and tell you that it succeeded to boot. If you apply a patch you've already applied, I will think it is a reversed patch, and offer to un-apply the patch. This could be construed as a feature. =head1 COMPATIBILITY The perl implementation of patch is based on but not entire compatible with the documentation for GNU patch version 2.1: =head2 note 1 On systems that do not support long filenames, GNU patch uses the extension "~" for backup files and the extension "#" for reject files. How to know if a system support long filenames? =head2 note 2 Only new-style context diffs are supported. What does old-style context diff look like? =head2 note 3 If the pipe to ed fails, B will attempt to apply the ed script on its own. =head2 note 4 This algorithm differs from the one described in the documentation for GNU patch, which scans forwards and backwards from the line number mentioned in the diff (plus any offset used in applying the previous hunk). =head2 note 5 Rejected hunks in GNU patch all come out as context diffs regardless of the input diff, and the lines numbers reflect the approximate location GNU patch thinks the failed hunks belong in the new file rather than the old one. =head2 note 6 If the original file cannot be found or is read-only, but a suitable SCCS or RCS file is handy, GNU patch will attempt to get or check out the file. =head2 note 7 GNU patch requires a space between the B<-D> and the argument. This has been made optional. =head2 note 8 There are currently no debugging flags to go along with B<-x>. =head1 AUTHOR Fuzzy | tgy@chocobo.org | Will hack Perl for a moogle stuffy! =^.^= =head1 COPYRIGHT Copyright (c) 1999 Moogle Stuffy Software. All rights reserved. You may play with this software in accordance with the Perl Artistic License. You may use this documentation under the auspices of the GNU General Public License. =cut Alien-wxWidgets-0.69/inc/inc_Archive-Extract000775000000000000 013075252612 21412 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/inc_Archive-Extract/Archive000775000000000000 013075252612 22773 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/inc_Archive-Extract/Archive/Extract.pm000664000000000000 10635512306621537 25156 0ustar00unknownunknown000000000000package Archive::Extract; use strict; use Cwd qw[cwd]; use Carp qw[carp]; use IPC::Cmd qw[run can_run]; use FileHandle; use File::Path qw[mkpath]; use File::Spec; use File::Basename qw[dirname basename]; use Params::Check qw[check]; use Module::Load::Conditional qw[can_load check_install]; use Locale::Maketext::Simple Style => 'gettext'; ### solaris has silly /bin/tar output ### use constant ON_SOLARIS => $^O eq 'solaris' ? 1 : 0; use constant FILE_EXISTS => sub { -e $_[0] ? 1 : 0 }; ### If these are changed, update @TYPES and the new() POD use constant TGZ => 'tgz'; use constant TAR => 'tar'; use constant GZ => 'gz'; use constant ZIP => 'zip'; use constant BZ2 => 'bz2'; use constant TBZ => 'tbz'; use constant Z => 'Z'; use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG]; $VERSION = '0.22'; $PREFER_BIN = 0; $WARN = 1; $DEBUG = 0; my @Types = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ, Z ); # same as all constants local $Params::Check::VERBOSE = $Params::Check::VERBOSE = 1; =pod =head1 NAME Archive::Extract - A generic archive extracting mechanism =head1 SYNOPSIS use Archive::Extract; ### build an Archive::Extract object ### my $ae = Archive::Extract->new( archive => 'foo.tgz' ); ### extract to cwd() ### my $ok = $ae->extract; ### extract to /tmp ### my $ok = $ae->extract( to => '/tmp' ); ### what if something went wrong? my $ok = $ae->extract or die $ae->error; ### files from the archive ### my $files = $ae->files; ### dir that was extracted to ### my $outdir = $ae->extract_path; ### quick check methods ### $ae->is_tar # is it a .tar file? $ae->is_tgz # is it a .tar.gz or .tgz file? $ae->is_gz; # is it a .gz file? $ae->is_zip; # is it a .zip file? $ae->is_bz2; # is it a .bz2 file? $ae->is_tbz; # is it a .tar.bz2 or .tbz file? ### absolute path to the archive you provided ### $ae->archive; ### commandline tools, if found ### $ae->bin_tar # path to /bin/tar, if found $ae->bin_gzip # path to /bin/gzip, if found $ae->bin_unzip # path to /bin/unzip, if found $ae->bin_bunzip2 # path to /bin/bunzip2 if found =head1 DESCRIPTION Archive::Extract is a generic archive extraction mechanism. It allows you to extract any archive file of the type .tar, .tar.gz, .gz, .Z, tar.bz2, .tbz, .bz2 or .zip without having to worry how it does so, or use different interfaces for each type by using either perl modules, or commandline tools on your system. See the C section further down for details. =cut ### see what /bin/programs are available ### $PROGRAMS = {}; for my $pgm (qw[tar unzip gzip bunzip2 uncompress]) { $PROGRAMS->{$pgm} = can_run($pgm); } ### mapping from types to extractor methods ### my $Mapping = { is_tgz => '_untar', is_tar => '_untar', is_gz => '_gunzip', is_zip => '_unzip', is_tbz => '_untar', is_bz2 => '_bunzip2', is_Z => '_uncompress', }; { my $tmpl = { archive => { required => 1, allow => FILE_EXISTS }, type => { default => '', allow => [ @Types ] }, }; ### build accesssors ### for my $method( keys %$tmpl, qw[_extractor _gunzip_to files extract_path], qw[_error_msg _error_msg_long] ) { no strict 'refs'; *$method = sub { my $self = shift; $self->{$method} = $_[0] if @_; return $self->{$method}; } } =head1 METHODS =head2 $ae = Archive::Extract->new(archive => '/path/to/archive',[type => TYPE]) Creates a new C object based on the archive file you passed it. Automatically determines the type of archive based on the extension, but you can override that by explicitly providing the C argument. Valid values for C are: =over 4 =item tar Standard tar files, as produced by, for example, C. Corresponds to a C<.tar> suffix. =item tgz Gzip compressed tar files, as produced by, for example C. Corresponds to a C<.tgz> or C<.tar.gz> suffix. =item gz Gzip compressed file, as produced by, for example C. Corresponds to a C<.gz> suffix. =item Z Lempel-Ziv compressed file, as produced by, for example C. Corresponds to a C<.Z> suffix. =item zip Zip compressed file, as produced by, for example C. Corresponds to a C<.zip>, C<.jar> or C<.par> suffix. =item bz2 Bzip2 compressed file, as produced by, for example, C. Corresponds to a C<.bz2> suffix. =item tbz Bzip2 compressed tar file, as produced by, for exmample C. Corresponds to a C<.tbz> or C<.tar.bz2> suffix. =back Returns a C object on success, or false on failure. =cut ### constructor ### sub new { my $class = shift; my %hash = @_; my $parsed = check( $tmpl, \%hash ) or return; ### make sure we have an absolute path ### my $ar = $parsed->{archive} = File::Spec->rel2abs( $parsed->{archive} ); ### figure out the type, if it wasn't already specified ### unless ( $parsed->{type} ) { $parsed->{type} = $ar =~ /.+?\.(?:tar\.gz|tgz)$/i ? TGZ : $ar =~ /.+?\.gz$/i ? GZ : $ar =~ /.+?\.tar$/i ? TAR : $ar =~ /.+?\.(zip|jar|par)$/i ? ZIP : $ar =~ /.+?\.(?:tbz|tar\.bz2?)$/i ? TBZ : $ar =~ /.+?\.bz2$/i ? BZ2 : $ar =~ /.+?\.Z$/ ? Z : ''; } ### don't know what type of file it is ### return __PACKAGE__->_error(loc("Cannot determine file type for '%1'", $parsed->{archive} )) unless $parsed->{type}; return bless $parsed, $class; } } =head2 $ae->extract( [to => '/output/path'] ) Extracts the archive represented by the C object to the path of your choice as specified by the C argument. Defaults to C. Since C<.gz> files never hold a directory, but only a single file; if the C argument is an existing directory, the file is extracted there, with it's C<.gz> suffix stripped. If the C argument is not an existing directory, the C argument is understood to be a filename, if the archive type is C. In the case that you did not specify a C argument, the output file will be the name of the archive file, stripped from it's C<.gz> suffix, in the current working directory. C will try a pure perl solution first, and then fall back to commandline tools if they are available. See the C section below on how to alter this behaviour. It will return true on success, and false on failure. On success, it will also set the follow attributes in the object: =over 4 =item $ae->extract_path This is the directory that the files where extracted to. =item $ae->files This is an array ref with the paths of all the files in the archive, relative to the C argument you specified. To get the full path to an extracted file, you would use: File::Spec->catfile( $to, $ae->files->[0] ); Note that all files from a tar archive will be in unix format, as per the tar specification. =back =cut sub extract { my $self = shift; my %hash = @_; my $to; my $tmpl = { to => { default => '.', store => \$to } }; check( $tmpl, \%hash ) or return; ### so 'to' could be a file or a dir, depending on whether it's a .gz ### file, or basically anything else. ### so, check that, then act accordingly. ### set an accessor specifically so _gunzip can know what file to extract ### to. my $dir; { ### a foo.gz file if( $self->is_gz or $self->is_bz2 or $self->is_Z) { my $cp = $self->archive; $cp =~ s/\.(?:gz|bz2|Z)$//i; ### to is a dir? if ( -d $to ) { $dir = $to; $self->_gunzip_to( basename($cp) ); ### then it's a filename } else { $dir = dirname($to); $self->_gunzip_to( basename($to) ); } ### not a foo.gz file } else { $dir = $to; } } ### make the dir if it doesn't exist ### unless( -d $dir ) { eval { mkpath( $dir ) }; return $self->_error(loc("Could not create path '%1': %2", $dir, $@)) if $@; } ### get the current dir, to restore later ### my $cwd = cwd(); my $ok = 1; EXTRACT: { ### chdir to the target dir ### unless( chdir $dir ) { $self->_error(loc("Could not chdir to '%1': %2", $dir, $!)); $ok = 0; last EXTRACT; } ### set files to an empty array ref, so there's always an array ### ref IN the accessor, to avoid errors like: ### Can't use an undefined value as an ARRAY reference at ### ../lib/Archive/Extract.pm line 742. (rt #19815) $self->files( [] ); ### find what extractor method to use ### while( my($type,$method) = each %$Mapping ) { ### call the corresponding method if the type is OK ### if( $self->$type) { $ok = $self->$method(); } } ### warn something went wrong if we didn't get an OK ### $self->_error(loc("Extract failed, no extractor found")) unless $ok; } ### and chdir back ### unless( chdir $cwd ) { $self->_error(loc("Could not chdir back to start dir '%1': %2'", $cwd, $!)); } return $ok; } =pod =head1 ACCESSORS =head2 $ae->error([BOOL]) Returns the last encountered error as string. Pass it a true value to get the C output instead. =head2 $ae->extract_path This is the directory the archive got extracted to. See C for details. =head2 $ae->files This is an array ref holding all the paths from the archive. See C for details. =head2 $ae->archive This is the full path to the archive file represented by this C object. =head2 $ae->type This is the type of archive represented by this C object. See accessors below for an easier way to use this. See the C method for details. =head2 $ae->types Returns a list of all known C for C's C method. =cut sub types { return @Types } =head2 $ae->is_tgz Returns true if the file is of type C<.tar.gz>. See the C method for details. =head2 $ae->is_tar Returns true if the file is of type C<.tar>. See the C method for details. =head2 $ae->is_gz Returns true if the file is of type C<.gz>. See the C method for details. =head2 $ae->is_Z Returns true if the file is of type C<.Z>. See the C method for details. =head2 $ae->is_zip Returns true if the file is of type C<.zip>. See the C method for details. =cut ### quick check methods ### sub is_tgz { return $_[0]->type eq TGZ } sub is_tar { return $_[0]->type eq TAR } sub is_gz { return $_[0]->type eq GZ } sub is_zip { return $_[0]->type eq ZIP } sub is_tbz { return $_[0]->type eq TBZ } sub is_bz2 { return $_[0]->type eq BZ2 } sub is_Z { return $_[0]->type eq Z } =pod =head2 $ae->bin_tar Returns the full path to your tar binary, if found. =head2 $ae->bin_gzip Returns the full path to your gzip binary, if found =head2 $ae->bin_unzip Returns the full path to your unzip binary, if found =cut ### paths to commandline tools ### sub bin_gzip { return $PROGRAMS->{'gzip'} if $PROGRAMS->{'gzip'} } sub bin_unzip { return $PROGRAMS->{'unzip'} if $PROGRAMS->{'unzip'} } sub bin_tar { return $PROGRAMS->{'tar'} if $PROGRAMS->{'tar'} } sub bin_bunzip2 { return $PROGRAMS->{'bunzip2'} if $PROGRAMS->{'bunzip2'} } sub bin_uncompress { return $PROGRAMS->{'uncompress'} if $PROGRAMS->{'uncompress'} } ################################# # # Untar code # ################################# ### untar wrapper... goes to either Archive::Tar or /bin/tar ### depending on $PREFER_BIN sub _untar { my $self = shift; ### bzip2 support in A::T via IO::Uncompress::Bzip2 my @methods = qw[_untar_at _untar_bin]; @methods = reverse @methods if $PREFER_BIN; for my $method (@methods) { $self->_extractor($method) && return 1 if $self->$method(); } return $self->_error(loc("Unable to untar file '%1'", $self->archive)); } ### use /bin/tar to extract ### sub _untar_bin { my $self = shift; ### check for /bin/tar ### return $self->_error(loc("No '%1' program found", '/bin/tar')) unless $self->bin_tar; ### check for /bin/gzip if we need it ### return $self->_error(loc("No '%1' program found", '/bin/gzip')) if $self->is_tgz && !$self->bin_gzip; return $self->_error(loc("No '%1' program found", '/bin/bunzip2')) if $self->is_tbz && !$self->bin_bunzip2; ### XXX figure out how to make IPC::Run do this in one call -- ### currently i don't know how to get output of a command after a pipe ### trapped in a scalar. Mailed barries about this 5th of june 2004. ### see what command we should run, based on whether ### it's a .tgz or .tar ### XXX solaris tar and bsdtar are having different outputs ### depending whether you run with -x or -t ### compensate for this insanity by running -t first, then -x { my $cmd = $self->is_tgz ? [$self->bin_gzip, '-cdf', $self->archive, '|', $self->bin_tar, '-tf', '-'] : $self->is_tbz ? [$self->bin_bunzip2, '-c', $self->archive, '|', $self->bin_tar, '-tf', '-'] : [$self->bin_tar, '-tf', $self->archive]; ### run the command ### my $buffer = ''; unless( scalar run( command => $cmd, buffer => \$buffer, verbose => $DEBUG ) ) { return $self->_error(loc( "Error listing contents of archive '%1': %2", $self->archive, $buffer )); } ### no buffers available? if( !IPC::Cmd->can_capture_buffer and !$buffer ) { $self->_error( $self->_no_buffer_files( $self->archive ) ); } else { ### if we're on solaris we /might/ be using /bin/tar, which has ### a weird output format... we might also be using ### /usr/local/bin/tar, which is gnu tar, which is perfectly ### fine... so we have to do some guessing here =/ my @files = map { chomp; !ON_SOLARIS ? $_ : (m|^ x \s+ # 'xtract' -- sigh (.+?), # the actual file name \s+ [\d,.]+ \s bytes, \s+ [\d,.]+ \s tape \s blocks |x ? $1 : $_); } split $/, $buffer; ### store the files that are in the archive ### $self->files(\@files); } } ### now actually extract it ### { my $cmd = $self->is_tgz ? [$self->bin_gzip, '-cdf', $self->archive, '|', $self->bin_tar, '-xf', '-'] : $self->is_tbz ? [$self->bin_bunzip2, '-c', $self->archive, '|', $self->bin_tar, '-xf', '-'] : [$self->bin_tar, '-xf', $self->archive]; my $buffer = ''; unless( scalar run( command => $cmd, buffer => \$buffer, verbose => $DEBUG ) ) { return $self->_error(loc("Error extracting archive '%1': %2", $self->archive, $buffer )); } ### we might not have them, due to lack of buffers if( $self->files ) { ### now that we've extracted, figure out where we extracted to my $dir = $self->__get_extract_dir( $self->files ); ### store the extraction dir ### $self->extract_path( $dir ); } } ### we got here, no error happened return 1; } ### use archive::tar to extract ### sub _untar_at { my $self = shift; ### we definitely need A::T, so load that first { my $use_list = { 'Archive::Tar' => '0.0' }; unless( can_load( modules => $use_list ) ) { return $self->_error(loc("You do not have '%1' installed - " . "Please install it as soon as possible.", 'Archive::Tar')); } } ### we might pass it a filehandle if it's a .tbz file.. my $fh_to_read = $self->archive; ### we will need Compress::Zlib too, if it's a tgz... and IO::Zlib ### if A::T's version is 0.99 or higher if( $self->is_tgz ) { my $use_list = { 'Compress::Zlib' => '0.0' }; $use_list->{ 'IO::Zlib' } = '0.0' if $Archive::Tar::VERSION >= '0.99'; unless( can_load( modules => $use_list ) ) { my $which = join '/', sort keys %$use_list; return $self->_error(loc( "You do not have '%1' installed - Please ". "install it as soon as possible.", $which)); } } elsif ( $self->is_tbz ) { my $use_list = { 'IO::Uncompress::Bunzip2' => '0.0' }; unless( can_load( modules => $use_list ) ) { return $self->_error(loc( "You do not have '%1' installed - Please " . "install it as soon as possible.", 'IO::Uncompress::Bunzip2')); } my $bz = IO::Uncompress::Bunzip2->new( $self->archive ) or return $self->_error(loc("Unable to open '%1': %2", $self->archive, $IO::Uncompress::Bunzip2::Bunzip2Error)); $fh_to_read = $bz; } my $tar = Archive::Tar->new(); ### only tell it it's compressed if it's a .tgz, as we give it a file ### handle if it's a .tbz unless( $tar->read( $fh_to_read, ( $self->is_tgz ? 1 : 0 ) ) ) { return $self->_error(loc("Unable to read '%1': %2", $self->archive, $Archive::Tar::error)); } ### workaround to prevent Archive::Tar from setting uid, which ### is a potential security hole. -autrijus ### have to do it here, since A::T needs to be /loaded/ first ### { no strict 'refs'; local $^W; ### older versions of archive::tar <= 0.23 *Archive::Tar::chown = sub {}; } ### for version of archive::tar > 1.04 local $Archive::Tar::Constant::CHOWN = 0; { local $^W; # quell 'splice() offset past end of array' warnings # on older versions of A::T ### older archive::tar always returns $self, return value slightly ### fux0r3d because of it. $tar->extract() or return $self->_error(loc("Unable to extract '%1': %2", $self->archive, $Archive::Tar::error )); } my @files = $tar->list_files; my $dir = $self->__get_extract_dir( \@files ); ### store the files that are in the archive ### $self->files(\@files); ### store the extraction dir ### $self->extract_path( $dir ); ### check if the dir actually appeared ### return 1 if -d $self->extract_path; ### no dir, we failed ### return $self->_error(loc("Unable to extract '%1': %2", $self->archive, $Archive::Tar::error )); } ################################# # # Gunzip code # ################################# ### gunzip wrapper... goes to either Compress::Zlib or /bin/gzip ### depending on $PREFER_BIN sub _gunzip { my $self = shift; my @methods = qw[_gunzip_cz _gunzip_bin]; @methods = reverse @methods if $PREFER_BIN; for my $method (@methods) { $self->_extractor($method) && return 1 if $self->$method(); } return $self->_error(loc("Unable to gunzip file '%1'", $self->archive)); } sub _gunzip_bin { my $self = shift; ### check for /bin/gzip -- we need it ### return $self->_error(loc("No '%1' program found", '/bin/gzip')) unless $self->bin_gzip; my $fh = FileHandle->new('>'. $self->_gunzip_to) or return $self->_error(loc("Could not open '%1' for writing: %2", $self->_gunzip_to, $! )); my $cmd = [ $self->bin_gzip, '-cdf', $self->archive ]; my $buffer; unless( scalar run( command => $cmd, verbose => $DEBUG, buffer => \$buffer ) ) { return $self->_error(loc("Unable to gunzip '%1': %2", $self->archive, $buffer)); } ### no buffers available? if( !IPC::Cmd->can_capture_buffer and !$buffer ) { $self->_error( $self->_no_buffer_content( $self->archive ) ); } print $fh $buffer if defined $buffer; close $fh; ### set what files where extract, and where they went ### $self->files( [$self->_gunzip_to] ); $self->extract_path( File::Spec->rel2abs(cwd()) ); return 1; } sub _gunzip_cz { my $self = shift; my $use_list = { 'Compress::Zlib' => '0.0' }; unless( can_load( modules => $use_list ) ) { return $self->_error(loc("You do not have '%1' installed - Please " . "install it as soon as possible.", 'Compress::Zlib')); } my $gz = Compress::Zlib::gzopen( $self->archive, "rb" ) or return $self->_error(loc("Unable to open '%1': %2", $self->archive, $Compress::Zlib::gzerrno)); my $fh = FileHandle->new('>'. $self->_gunzip_to) or return $self->_error(loc("Could not open '%1' for writing: %2", $self->_gunzip_to, $! )); my $buffer; $fh->print($buffer) while $gz->gzread($buffer) > 0; $fh->close; ### set what files where extract, and where they went ### $self->files( [$self->_gunzip_to] ); $self->extract_path( File::Spec->rel2abs(cwd()) ); return 1; } ################################# # # Uncompress code # ################################# ### untar wrapper... goes to either Archive::Tar or /bin/tar ### depending on $PREFER_BIN sub _uncompress { my $self = shift; my @methods = qw[_gunzip_cz _uncompress_bin]; @methods = reverse @methods if $PREFER_BIN; for my $method (@methods) { $self->_extractor($method) && return 1 if $self->$method(); } return $self->_error(loc("Unable to untar file '%1'", $self->archive)); } sub _uncompress_bin { my $self = shift; ### check for /bin/gzip -- we need it ### return $self->_error(loc("No '%1' program found", '/bin/uncompress')) unless $self->bin_uncompress; my $fh = FileHandle->new('>'. $self->_gunzip_to) or return $self->_error(loc("Could not open '%1' for writing: %2", $self->_gunzip_to, $! )); my $cmd = [ $self->bin_uncompress, '-c', $self->archive ]; my $buffer; unless( scalar run( command => $cmd, verbose => $DEBUG, buffer => \$buffer ) ) { return $self->_error(loc("Unable to uncompress '%1': %2", $self->archive, $buffer)); } ### no buffers available? if( !IPC::Cmd->can_capture_buffer and !$buffer ) { $self->_error( $self->_no_buffer_content( $self->archive ) ); } print $fh $buffer if defined $buffer; close $fh; ### set what files where extract, and where they went ### $self->files( [$self->_gunzip_to] ); $self->extract_path( File::Spec->rel2abs(cwd()) ); return 1; } ################################# # # Unzip code # ################################# ### unzip wrapper... goes to either Archive::Zip or /bin/unzip ### depending on $PREFER_BIN sub _unzip { my $self = shift; my @methods = qw[_unzip_az _unzip_bin]; @methods = reverse @methods if $PREFER_BIN; for my $method (@methods) { $self->_extractor($method) && return 1 if $self->$method(); } return $self->_error(loc("Unable to gunzip file '%1'", $self->archive)); } sub _unzip_bin { my $self = shift; ### check for /bin/gzip if we need it ### return $self->_error(loc("No '%1' program found", '/bin/unzip')) unless $self->bin_unzip; ### first, get the files.. it must be 2 different commands with 'unzip' :( { my $cmd = [ $self->bin_unzip, '-Z', '-1', $self->archive ]; my $buffer = ''; unless( scalar run( command => $cmd, verbose => $DEBUG, buffer => \$buffer ) ) { return $self->_error(loc("Unable to unzip '%1': %2", $self->archive, $buffer)); } ### no buffers available? if( !IPC::Cmd->can_capture_buffer and !$buffer ) { $self->_error( $self->_no_buffer_files( $self->archive ) ); } else { $self->files( [split $/, $buffer] ); } } ### now, extract the archive ### { my $cmd = [ $self->bin_unzip, '-qq', '-o', $self->archive ]; my $buffer; unless( scalar run( command => $cmd, verbose => $DEBUG, buffer => \$buffer ) ) { return $self->_error(loc("Unable to unzip '%1': %2", $self->archive, $buffer)); } if( scalar @{$self->files} ) { my $files = $self->files; my $dir = $self->__get_extract_dir( $files ); $self->extract_path( $dir ); } } return 1; } sub _unzip_az { my $self = shift; my $use_list = { 'Archive::Zip' => '0.0' }; unless( can_load( modules => $use_list ) ) { return $self->_error(loc("You do not have '%1' installed - Please " . "install it as soon as possible.", 'Archive::Zip')); } my $zip = Archive::Zip->new(); unless( $zip->read( $self->archive ) == &Archive::Zip::AZ_OK ) { return $self->_error(loc("Unable to read '%1'", $self->archive)); } my @files; ### have to extract every memeber individually ### for my $member ($zip->members) { push @files, $member->{fileName}; unless( $zip->extractMember($member) == &Archive::Zip::AZ_OK ) { return $self->_error(loc("Extraction of '%1' from '%2' failed", $member->{fileName}, $self->archive )); } } my $dir = $self->__get_extract_dir( \@files ); ### set what files where extract, and where they went ### $self->files( \@files ); $self->extract_path( File::Spec->rel2abs($dir) ); return 1; } sub __get_extract_dir { my $self = shift; my $files = shift || []; return unless scalar @$files; my($dir1, $dir2); for my $aref ( [ \$dir1, 0 ], [ \$dir2, -1 ] ) { my($dir,$pos) = @$aref; ### add a catdir(), so that any trailing slashes get ### take care of (removed) ### also, a catdir() normalises './dir/foo' to 'dir/foo'; ### which was the problem in bug #23999 my $res = -d $files->[$pos] ? File::Spec->catdir( $files->[$pos], '' ) : File::Spec->catdir( dirname( $files->[$pos] ) ); $$dir = $res; } ### if the first and last dir don't match, make sure the ### dirname is not set wrongly my $dir; ### dirs are the same, so we know for sure what the extract dir is if( $dir1 eq $dir2 ) { $dir = $dir1; ### dirs are different.. do they share the base dir? ### if so, use that, if not, fall back to '.' } else { my $base1 = [ File::Spec->splitdir( $dir1 ) ]->[0]; my $base2 = [ File::Spec->splitdir( $dir2 ) ]->[0]; $dir = File::Spec->rel2abs( $base1 eq $base2 ? $base1 : '.' ); } return File::Spec->rel2abs( $dir ); } ################################# # # Bunzip2 code # ################################# ### bunzip2 wrapper... sub _bunzip2 { my $self = shift; my @methods = qw[_bunzip2_cz2 _bunzip2_bin]; @methods = reverse @methods if $PREFER_BIN; for my $method (@methods) { $self->_extractor($method) && return 1 if $self->$method(); } return $self->_error(loc("Unable to bunzip2 file '%1'", $self->archive)); } sub _bunzip2_bin { my $self = shift; ### check for /bin/gzip -- we need it ### return $self->_error(loc("No '%1' program found", '/bin/bunzip2')) unless $self->bin_bunzip2; my $fh = FileHandle->new('>'. $self->_gunzip_to) or return $self->_error(loc("Could not open '%1' for writing: %2", $self->_gunzip_to, $! )); my $cmd = [ $self->bin_bunzip2, '-c', $self->archive ]; my $buffer; unless( scalar run( command => $cmd, verbose => $DEBUG, buffer => \$buffer ) ) { return $self->_error(loc("Unable to bunzip2 '%1': %2", $self->archive, $buffer)); } ### no buffers available? if( !IPC::Cmd->can_capture_buffer and !$buffer ) { $self->_error( $self->_no_buffer_content( $self->archive ) ); } print $fh $buffer if defined $buffer; close $fh; ### set what files where extract, and where they went ### $self->files( [$self->_gunzip_to] ); $self->extract_path( File::Spec->rel2abs(cwd()) ); return 1; } ### using cz2, the compact versions... this we use mainly in archive::tar ### extractor.. # sub _bunzip2_cz1 { # my $self = shift; # # my $use_list = { 'IO::Uncompress::Bunzip2' => '0.0' }; # unless( can_load( modules => $use_list ) ) { # return $self->_error(loc("You do not have '%1' installed - Please " . # "install it as soon as possible.", # 'IO::Uncompress::Bunzip2')); # } # # my $bz = IO::Uncompress::Bunzip2->new( $self->archive ) or # return $self->_error(loc("Unable to open '%1': %2", # $self->archive, # $IO::Uncompress::Bunzip2::Bunzip2Error)); # # my $fh = FileHandle->new('>'. $self->_gunzip_to) or # return $self->_error(loc("Could not open '%1' for writing: %2", # $self->_gunzip_to, $! )); # # my $buffer; # $fh->print($buffer) while $bz->read($buffer) > 0; # $fh->close; # # ### set what files where extract, and where they went ### # $self->files( [$self->_gunzip_to] ); # $self->extract_path( File::Spec->rel2abs(cwd()) ); # # return 1; # } sub _bunzip2_cz2 { my $self = shift; my $use_list = { 'IO::Uncompress::Bunzip2' => '0.0' }; unless( can_load( modules => $use_list ) ) { return $self->_error(loc("You do not have '%1' installed - Please " . "install it as soon as possible.", 'IO::Uncompress::Bunzip2')); } IO::Uncompress::Bunzip2::bunzip2($self->archive => $self->_gunzip_to) or return $self->_error(loc("Unable to uncompress '%1': %2", $self->archive, $IO::Uncompress::Bunzip2::Bunzip2Error)); ### set what files where extract, and where they went ### $self->files( [$self->_gunzip_to] ); $self->extract_path( File::Spec->rel2abs(cwd()) ); return 1; } ################################# # # Error code # ################################# sub _error { my $self = shift; my $error = shift; $self->_error_msg( $error ); $self->_error_msg_long( Carp::longmess($error) ); ### set $Archive::Extract::WARN to 0 to disable printing ### of errors if( $WARN ) { carp $DEBUG ? $self->_error_msg_long : $self->_error_msg; } return; } sub error { my $self = shift; return shift() ? $self->_error_msg_long : $self->_error_msg; } sub _no_buffer_files { my $self = shift; my $file = shift or return; return loc("No buffer captured, unable to tell ". "extracted files or extraction dir for '%1'", $file); } sub _no_buffer_content { my $self = shift; my $file = shift or return; return loc("No buffer captured, unable to get content for '%1'", $file); } 1; =pod =head1 HOW IT WORKS C tries first to determine what type of archive you are passing it, by inspecting its suffix. It does not do this by using Mime magic, or something related. See C below. Once it has determined the file type, it knows which extraction methods it can use on the archive. It will try a perl solution first, then fall back to a commandline tool if that fails. If that also fails, it will return false, indicating it was unable to extract the archive. See the section on C to see how to alter this order. =head1 CAVEATS =head2 File Extensions C trusts on the extension of the archive to determine what type it is, and what extractor methods therefore can be used. If your archives do not have any of the extensions as described in the C method, you will have to specify the type explicitly, or C will not be able to extract the archive for you. =head2 Bzip2 Support There's currently no very reliable pure perl Bzip2 implementation available, so C can only extract C compressed archives if you have a C program. =head1 GLOBAL VARIABLES =head2 $Archive::Extract::DEBUG Set this variable to C to have all calls to command line tools be printed out, including all their output. This also enables C errors, instead of the regular C errors. Good for tracking down why things don't work with your particular setup. Defaults to C. =head2 $Archive::Extract::WARN This variable controls whether errors encountered internally by C should be C'd or not. Set to false to silence warnings. Inspect the output of the C method manually to see what went wrong. Defaults to C. =head2 $Archive::Extract::PREFER_BIN This variables controls whether C should prefer the use of perl modules, or commandline tools to extract archives. Set to C to have C prefer commandline tools. Defaults to C. =head1 TODO =over 4 =item Mime magic support Maybe this module should use something like C to determine the type, rather than blindly trust the suffix. =back =head1 BUG REPORTS Please report bugs or other issues to Ebug-archive-extract@rt.cpan.org. =head1 AUTHOR This module by Jos Boumans Ekane@cpan.orgE. =head1 COPYRIGHT This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut # Local variables: # c-indentation-style: bsd # c-basic-offset: 4 # indent-tabs-mode: nil # End: # vim: expandtab shiftwidth=4: Alien-wxWidgets-0.69/inc/inc_File-Fetch000775000000000000 013075252612 20327 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/inc_File-Fetch/File000775000000000000 013075252612 21206 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/inc_File-Fetch/File/Fetch.pm000664000000000000 6715512306621537 22774 0ustar00unknownunknown000000000000package File::Fetch; use strict; use FileHandle; use File::Copy; use File::Spec; use File::Spec::Unix; use File::Basename qw[dirname]; use Cwd qw[cwd]; use Carp qw[carp]; use IPC::Cmd qw[can_run run]; use File::Path qw[mkpath]; use Params::Check qw[check]; use Module::Load::Conditional qw[can_load]; use Locale::Maketext::Simple Style => 'gettext'; use vars qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT $BLACKLIST $METHOD_FAIL $VERSION $METHODS $FTP_PASSIVE $TIMEOUT $DEBUG $WARN ]; use constant QUOTE => do { $^O eq 'MSWin32' ? q["] : q['] }; $VERSION = '0.10'; $PREFER_BIN = 0; # XXX TODO implement $FROM_EMAIL = 'File-Fetch@example.com'; $USER_AGENT = 'File::Fetch/$VERSION'; $BLACKLIST = [qw|ftp|]; $METHOD_FAIL = { }; $FTP_PASSIVE = 1; $TIMEOUT = 0; $DEBUG = 0; $WARN = 1; ### methods available to fetch the file depending on the scheme $METHODS = { http => [ qw|lwp wget curl lynx| ], ftp => [ qw|lwp netftp wget curl ncftp ftp| ], file => [ qw|lwp file| ], rsync => [ qw|rsync| ] }; ### silly warnings ### local $Params::Check::VERBOSE = 1; local $Params::Check::VERBOSE = 1; local $Module::Load::Conditional::VERBOSE = 0; local $Module::Load::Conditional::VERBOSE = 0; ### see what OS we are on, important for file:// uris ### use constant ON_UNIX => ($^O ne 'MSWin32' and $^O ne 'MacOS' and $^O ne 'VMS'); =pod =head1 NAME File::Fetch - A generic file fetching mechanism =head1 SYNOPSIS use File::Fetch; ### build a File::Fetch object ### my $ff = File::Fetch->new(uri => 'http://some.where.com/dir/a.txt'); ### fetch the uri to cwd() ### my $where = $ff->fetch() or die $ff->error; ### fetch the uri to /tmp ### my $where = $ff->fetch( to => '/tmp' ); ### parsed bits from the uri ### $ff->uri; $ff->scheme; $ff->host; $ff->path; $ff->file; =head1 DESCRIPTION File::Fetch is a generic file fetching mechanism. It allows you to fetch any file pointed to by a C, C, C, or C uri by a number of different means. See the C section further down for details. =head1 ACCESSORS A C object has the following accessors =over 4 =item $ff->uri The uri you passed to the constructor =item $ff->scheme The scheme from the uri (like 'file', 'http', etc) =item $ff->host The hostname in the uri, will be empty for a 'file' scheme. =item $ff->path The path from the uri, will be at least a single '/'. =item $ff->file The name of the remote file. For the local file name, the result of $ff->output_file will be used. =cut ########################## ### Object & Accessors ### ########################## { ### template for new() and autogenerated accessors ### my $Tmpl = { scheme => { default => 'http' }, host => { default => 'localhost' }, path => { default => '/' }, file => { required => 1 }, uri => { required => 1 }, _error_msg => { no_override => 1 }, _error_msg_long => { no_override => 1 }, }; for my $method ( keys %$Tmpl ) { no strict 'refs'; *$method = sub { my $self = shift; $self->{$method} = $_[0] if @_; return $self->{$method}; } } sub _create { my $class = shift; my %hash = @_; my $args = check( $Tmpl, \%hash ) or return; bless $args, $class; if( lc($args->scheme) ne 'file' and not $args->host ) { return File::Fetch->_error(loc( "Hostname required when fetching from '%1'",$args->scheme)); } for (qw[path file]) { unless( $args->$_ ) { return File::Fetch->_error(loc("No '%1' specified",$_)); } } return $args; } } =item $ff->output_file The name of the output file. This is the same as $ff->file, but any query parameters are stripped off. For example: http://example.com/index.html?x=y would make the output file be C rather than C. =back =cut sub output_file { my $self = shift; my $file = $self->file; $file =~ s/\?.*$//g; return $file; } ### XXX do this or just point to URI::Escape? # =head2 $esc_uri = $ff->escaped_uri # # =cut # # ### most of this is stolen straight from URI::escape # { ### Build a char->hex map # my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255; # # sub escaped_uri { # my $self = shift; # my $uri = $self->uri; # # ### Default unsafe characters. RFC 2732 ^(uric - reserved) # $uri =~ s/([^A-Za-z0-9\-_.!~*'()])/ # $escapes{$1} || $self->_fail_hi($1)/ge; # # return $uri; # } # # sub _fail_hi { # my $self = shift; # my $char = shift; # # $self->_error(loc( # "Can't escape '%1', try using the '%2' module instead", # sprintf("\\x{%04X}", ord($char)), 'URI::Escape' # )); # } # # sub output_file { # # } # # # } =head1 METHODS =head2 $ff = File::Fetch->new( uri => 'http://some.where.com/dir/file.txt' ); Parses the uri and creates a corresponding File::Fetch::Item object, that is ready to be Ced and returns it. Returns false on failure. =cut sub new { my $class = shift; my %hash = @_; my ($uri); my $tmpl = { uri => { required => 1, store => \$uri }, }; check( $tmpl, \%hash ) or return; ### parse the uri to usable parts ### my $href = __PACKAGE__->_parse_uri( $uri ) or return; ### make it into a FFI object ### my $ff = File::Fetch->_create( %$href ) or return; ### return the object ### return $ff; } ### parses an uri to a hash structure: ### ### $class->_parse_uri( 'ftp://ftp.cpan.org/pub/mirror/index.txt' ) ### ### becomes: ### ### $href = { ### scheme => 'ftp', ### host => 'ftp.cpan.org', ### path => '/pub/mirror', ### file => 'index.html' ### }; ### sub _parse_uri { my $self = shift; my $uri = shift or return; my $href = { uri => $uri }; ### find the scheme ### $uri =~ s|^(\w+)://||; $href->{scheme} = $1; ### file:// paths have no host ### if( $href->{scheme} eq 'file' ) { $href->{path} = $uri; $href->{host} = ''; } else { @{$href}{qw|host path|} = $uri =~ m|([^/]*)(/.*)$|s; } ### split the path into file + dir ### { my @parts = File::Spec::Unix->splitpath( delete $href->{path} ); $href->{path} = $parts[1]; $href->{file} = $parts[2]; } return $href; } =head2 $ff->fetch( [to => /my/output/dir/] ) Fetches the file you requested. By default it writes to C, but you can override that by specifying the C argument. Returns the full path to the downloaded file on success, and false on failure. =cut sub fetch { my $self = shift or return; my %hash = @_; my $to; my $tmpl = { to => { default => cwd(), store => \$to }, }; check( $tmpl, \%hash ) or return; ### create the path if it doesn't exist yet ### unless( -d $to ) { eval { mkpath( $to ) }; return $self->_error(loc("Could not create path '%1'",$to)) if $@; } ### set passive ftp if required ### local $ENV{FTP_PASSIVE} = $FTP_PASSIVE; ### for my $method ( @{ $METHODS->{$self->scheme} } ) { my $sub = '_'.$method.'_fetch'; unless( __PACKAGE__->can($sub) ) { $self->_error(loc("Cannot call method for '%1' -- WEIRD!", $method)); next; } ### method is blacklisted ### next if grep { lc $_ eq $method } @$BLACKLIST; ### method is known to fail ### next if $METHOD_FAIL->{$method}; ### there's serious issues with IPC::Run and quoting of command ### line arguments. using quotes in the wrong place breaks things, ### and in the case of say, ### C:\cygwin\bin\wget.EXE --quiet --passive-ftp --output-document ### "index.html" "http://www.cpan.org/index.html?q=1&y=2" ### it doesn't matter how you quote, it always fails. local $IPC::Cmd::USE_IPC_RUN = 0; if( my $file = $self->$sub( to => File::Spec->catfile( $to, $self->output_file ) )){ unless( -e $file && -s _ ) { $self->_error(loc("'%1' said it fetched '%2', ". "but it was not created",$method,$file)); ### mark the failure ### $METHOD_FAIL->{$method} = 1; next; } else { my $abs = File::Spec->rel2abs( $file ); return $abs; } } } ### if we got here, we looped over all methods, but we weren't able ### to fetch it. return; } ######################## ### _*_fetch methods ### ######################## ### LWP fetching ### sub _lwp_fetch { my $self = shift; my %hash = @_; my ($to); my $tmpl = { to => { required => 1, store => \$to } }; check( $tmpl, \%hash ) or return; ### modules required to download with lwp ### my $use_list = { LWP => '0.0', 'LWP::UserAgent' => '0.0', 'HTTP::Request' => '0.0', 'HTTP::Status' => '0.0', URI => '0.0', }; if( can_load(modules => $use_list) ) { ### setup the uri object my $uri = URI->new( File::Spec::Unix->catfile( $self->path, $self->file ) ); ### special rules apply for file:// uris ### $uri->scheme( $self->scheme ); $uri->host( $self->scheme eq 'file' ? '' : $self->host ); $uri->userinfo("anonymous:$FROM_EMAIL") if $self->scheme ne 'file'; ### set up the useragent object my $ua = LWP::UserAgent->new(); $ua->timeout( $TIMEOUT ) if $TIMEOUT; $ua->agent( $USER_AGENT ); $ua->from( $FROM_EMAIL ); $ua->env_proxy; my $res = $ua->mirror($uri, $to) or return; ### uptodate or fetched ok ### if ( $res->code == 304 or $res->code == 200 ) { return $to; } else { return $self->_error(loc("Fetch failed! HTTP response: %1 %2 [%3]", $res->code, HTTP::Status::status_message($res->code), $res->status_line)); } } else { $METHOD_FAIL->{'lwp'} = 1; return; } } ### Net::FTP fetching sub _netftp_fetch { my $self = shift; my %hash = @_; my ($to); my $tmpl = { to => { required => 1, store => \$to } }; check( $tmpl, \%hash ) or return; ### required modules ### my $use_list = { 'Net::FTP' => 0 }; if( can_load( modules => $use_list ) ) { ### make connection ### my $ftp; my @options = ($self->host); push(@options, Timeout => $TIMEOUT) if $TIMEOUT; unless( $ftp = Net::FTP->new( @options ) ) { return $self->_error(loc("Ftp creation failed: %1",$@)); } ### login ### unless( $ftp->login( anonymous => $FROM_EMAIL ) ) { return $self->_error(loc("Could not login to '%1'",$self->host)); } ### set binary mode, just in case ### $ftp->binary; ### create the remote path ### remember remote paths are unix paths! [#11483] my $remote = File::Spec::Unix->catfile( $self->path, $self->file ); ### fetch the file ### my $target; unless( $target = $ftp->get( $remote, $to ) ) { return $self->_error(loc("Could not fetch '%1' from '%2'", $remote, $self->host)); } ### log out ### $ftp->quit; return $target; } else { $METHOD_FAIL->{'netftp'} = 1; return; } } ### /bin/wget fetch ### sub _wget_fetch { my $self = shift; my %hash = @_; my ($to); my $tmpl = { to => { required => 1, store => \$to } }; check( $tmpl, \%hash ) or return; ### see if we have a wget binary ### if( my $wget = can_run('wget') ) { ### no verboseness, thanks ### my $cmd = [ $wget, '--quiet' ]; ### if a timeout is set, add it ### push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT; ### run passive if specified ### push @$cmd, '--passive-ftp' if $FTP_PASSIVE; ### set the output document, add the uri ### push @$cmd, '--output-document', ### DO NOT quote things for IPC::Run, it breaks stuff. $IPC::Cmd::USE_IPC_RUN ? ($to, $self->uri) : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); ### shell out ### my $captured; unless(run( command => $cmd, buffer => \$captured, verbose => $DEBUG )) { ### wget creates the output document always, even if the fetch ### fails.. so unlink it in that case 1 while unlink $to; return $self->_error(loc( "Command failed: %1", $captured || '' )); } return $to; } else { $METHOD_FAIL->{'wget'} = 1; return; } } ### /bin/ftp fetch ### sub _ftp_fetch { my $self = shift; my %hash = @_; my ($to); my $tmpl = { to => { required => 1, store => \$to } }; check( $tmpl, \%hash ) or return; ### see if we have a ftp binary ### if( my $ftp = can_run('ftp') ) { my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { return $self->_error(loc("%1 creation failed: %2", $ftp, $!)); } my @dialog = ( "lcd " . dirname($to), "open " . $self->host, "user anonymous $FROM_EMAIL", "cd /", "cd " . $self->path, "binary", "get " . $self->file . " " . $self->output_file, "quit", ); foreach (@dialog) { $fh->print($_, "\n") } $fh->close or return; return $to; } } ### lynx is stupid - it decompresses any .gz file it finds to be text ### use /bin/lynx to fetch files sub _lynx_fetch { my $self = shift; my %hash = @_; my ($to); my $tmpl = { to => { required => 1, store => \$to } }; check( $tmpl, \%hash ) or return; ### see if we have a lynx binary ### if( my $lynx = can_run('lynx') ) { unless( IPC::Cmd->can_capture_buffer ) { $METHOD_FAIL->{'lynx'} = 1; return $self->_error(loc( "Can not capture buffers. Can not use '%1' to fetch files", 'lynx' )); } ### write to the output file ourselves, since lynx ass_u_mes to much my $local = FileHandle->new(">$to") or return $self->_error(loc( "Could not open '%1' for writing: %2",$to,$!)); ### dump to stdout ### my $cmd = [ $lynx, '-source', "-auth=anonymous:$FROM_EMAIL", ]; push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT; ### DO NOT quote things for IPC::Run, it breaks stuff. push @$cmd, $IPC::Cmd::USE_IPC_RUN ? $self->uri : QUOTE. $self->uri .QUOTE; ### shell out ### my $captured; unless(run( command => $cmd, buffer => \$captured, verbose => $DEBUG ) ) { return $self->_error(loc("Command failed: %1", $captured || '')); } ### print to local file ### ### XXX on a 404 with a special error page, $captured will actually ### hold the contents of that page, and make it *appear* like the ### request was a success, when really it wasn't :( ### there doesn't seem to be an option for lynx to change the exit ### code based on a 4XX status or so. ### the closest we can come is using --error_file and parsing that, ### which is very unreliable ;( $local->print( $captured ); $local->close or return; return $to; } else { $METHOD_FAIL->{'lynx'} = 1; return; } } ### use /bin/ncftp to fetch files sub _ncftp_fetch { my $self = shift; my %hash = @_; my ($to); my $tmpl = { to => { required => 1, store => \$to } }; check( $tmpl, \%hash ) or return; ### we can only set passive mode in interactive sesssions, so bail out ### if $FTP_PASSIVE is set return if $FTP_PASSIVE; ### see if we have a ncftp binary ### if( my $ncftp = can_run('ncftp') ) { my $cmd = [ $ncftp, '-V', # do not be verbose '-p', $FROM_EMAIL, # email as password $self->host, # hostname dirname($to), # local dir for the file # remote path to the file ### DO NOT quote things for IPC::Run, it breaks stuff. $IPC::Cmd::USE_IPC_RUN ? File::Spec::Unix->catdir( $self->path, $self->file ) : QUOTE. File::Spec::Unix->catdir( $self->path, $self->file ) .QUOTE ]; ### shell out ### my $captured; unless(run( command => $cmd, buffer => \$captured, verbose => $DEBUG ) ) { return $self->_error(loc("Command failed: %1", $captured || '')); } return $to; } else { $METHOD_FAIL->{'ncftp'} = 1; return; } } ### use /bin/curl to fetch files sub _curl_fetch { my $self = shift; my %hash = @_; my ($to); my $tmpl = { to => { required => 1, store => \$to } }; check( $tmpl, \%hash ) or return; if (my $curl = can_run('curl')) { ### these long opts are self explanatory - I like that -jmb my $cmd = [ $curl ]; push(@$cmd, '--connect-timeout', $TIMEOUT) if $TIMEOUT; push(@$cmd, '--silent') unless $DEBUG; ### curl does the right thing with passive, regardless ### if ($self->scheme eq 'ftp') { push(@$cmd, '--user', "anonymous:$FROM_EMAIL"); } ### curl doesn't follow 302 (temporarily moved) etc automatically ### so we add --location to enable that. push @$cmd, '--fail', '--location', '--output', ### DO NOT quote things for IPC::Run, it breaks stuff. $IPC::Cmd::USE_IPC_RUN ? ($to, $self->uri) : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); my $captured; unless(run( command => $cmd, buffer => \$captured, verbose => $DEBUG ) ) { return $self->_error(loc("Command failed: %1", $captured || '')); } return $to; } else { $METHOD_FAIL->{'curl'} = 1; return; } } ### use File::Copy for fetching file:// urls ### ### XXX file:// uri to local path conversion is just too weird... ### depend on LWP to do it for us sub _file_fetch { my $self = shift; my %hash = @_; my ($to); my $tmpl = { to => { required => 1, store => \$to } }; check( $tmpl, \%hash ) or return; ### prefix a / on unix systems with a file uri, since it would ### look somewhat like this: ### file://home/kane/file ### wheras windows file uris might look like: ### file://C:/home/kane/file my $path = ON_UNIX ? '/'. $self->path : $self->path; my $remote = File::Spec->catfile( $path, $self->file ); ### File::Copy is littered with 'die' statements :( ### my $rv = eval { File::Copy::copy( $remote, $to ) }; ### something went wrong ### if( !$rv or $@ ) { return $self->_error(loc("Could not copy '%1' to '%2': %3 %4", $remote, $to, $!, $@)); } return $to; } ### use /usr/bin/rsync to fetch files sub _rsync_fetch { my $self = shift; my %hash = @_; my ($to); my $tmpl = { to => { required => 1, store => \$to } }; check( $tmpl, \%hash ) or return; if (my $rsync = can_run('rsync')) { my $cmd = [ $rsync ]; ### XXX: rsync has no I/O timeouts at all, by default push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT; push(@$cmd, '--quiet') unless $DEBUG; ### DO NOT quote things for IPC::Run, it breaks stuff. push @$cmd, $IPC::Cmd::USE_IPC_RUN ? ($self->uri, $to) : (QUOTE. $self->uri .QUOTE, QUOTE. $to .QUOTE); my $captured; unless(run( command => $cmd, buffer => \$captured, verbose => $DEBUG ) ) { return $self->_error(loc("Command failed: %1", $captured || '')); } return $to; } else { $METHOD_FAIL->{'rsync'} = 1; return; } } ################################# # # Error code # ################################# =pod =head2 $ff->error([BOOL]) Returns the last encountered error as string. Pass it a true value to get the C output instead. =cut ### error handling the way Archive::Extract does it sub _error { my $self = shift; my $error = shift; $self->_error_msg( $error ); $self->_error_msg_long( Carp::longmess($error) ); if( $WARN ) { carp $DEBUG ? $self->_error_msg_long : $self->_error_msg; } return; } sub error { my $self = shift; return shift() ? $self->_error_msg_long : $self->_error_msg; } 1; =pod =head1 HOW IT WORKS File::Fetch is able to fetch a variety of uris, by using several external programs and modules. Below is a mapping of what utilities will be used in what order for what schemes, if available: file => LWP, file http => LWP, wget, curl, lynx ftp => LWP, Net::FTP, wget, curl, ncftp, ftp rsync => rsync If you'd like to disable the use of one or more of these utilities and/or modules, see the C<$BLACKLIST> variable further down. If a utility or module isn't available, it will be marked in a cache (see the C<$METHOD_FAIL> variable further down), so it will not be tried again. The C method will only fail when all options are exhausted, and it was not able to retrieve the file. A special note about fetching files from an ftp uri: By default, all ftp connections are done in passive mode. To change that, see the C<$FTP_PASSIVE> variable further down. Furthermore, ftp uris only support anonymous connections, so no named user/password pair can be passed along. C is blacklisted by default; see the C<$BLACKLIST> variable further down. =head1 GLOBAL VARIABLES The behaviour of File::Fetch can be altered by changing the following global variables: =head2 $File::Fetch::FROM_EMAIL This is the email address that will be sent as your anonymous ftp password. Default is C. =head2 $File::Fetch::USER_AGENT This is the useragent as C will report it. Default is C. =head2 $File::Fetch::FTP_PASSIVE This variable controls whether the environment variable C and any passive switches to commandline tools will be set to true. Default value is 1. Note: When $FTP_PASSIVE is true, C will not be used to fetch files, since passive mode can only be set interactively for this binary =head2 $File::Fetch::TIMEOUT When set, controls the network timeout (counted in seconds). Default value is 0. =head2 $File::Fetch::WARN This variable controls whether errors encountered internally by C should be C'd or not. Set to false to silence warnings. Inspect the output of the C method manually to see what went wrong. Defaults to C. =head2 $File::Fetch::DEBUG This enables debugging output when calling commandline utilities to fetch files. This also enables C errors, instead of the regular C errors. Good for tracking down why things don't work with your particular setup. Default is 0. =head2 $File::Fetch::BLACKLIST This is an array ref holding blacklisted modules/utilities for fetching files with. To disallow the use of, for example, C and C, you could set $File::Fetch::BLACKLIST to: $File::Fetch::BLACKLIST = [qw|lwp netftp|] The default blacklist is [qw|ftp|], as C is rather unreliable. See the note on C below. =head2 $File::Fetch::METHOD_FAIL This is a hashref registering what modules/utilities were known to fail for fetching files (mostly because they weren't installed). You can reset this cache by assigning an empty hashref to it, or individually remove keys. See the note on C below. =head1 MAPPING Here's a quick mapping for the utilities/modules, and their names for the $BLACKLIST, $METHOD_FAIL and other internal functions. LWP => lwp Net::FTP => netftp wget => wget lynx => lynx ncftp => ncftp ftp => ftp curl => curl rsync => rsync =head1 FREQUENTLY ASKED QUESTIONS =head2 So how do I use a proxy with File::Fetch? C currently only supports proxies with LWP::UserAgent. You will need to set your environment variables accordingly. For example, to use an ftp proxy: $ENV{ftp_proxy} = 'foo.com'; Refer to the LWP::UserAgent manpage for more details. =head2 I used 'lynx' to fetch a file, but its contents is all wrong! C can only fetch remote files by dumping its contents to C, which we in turn capture. If that content is a 'custom' error file (like, say, a C<404 handler>), you will get that contents instead. Sadly, C doesn't support any options to return a different exit code on non-C<200 OK> status, giving us no way to tell the difference between a 'successfull' fetch and a custom error page. Therefor, we recommend to only use C as a last resort. This is why it is at the back of our list of methods to try as well. =head2 Files I'm trying to fetch have reserved characters or non-ASCII characters in them. What do I do? C is relatively smart about things. When trying to write a file to disk, it removes the C (see the C method for details) from the file name before creating it. In most cases this suffices. If you have any other characters you need to escape, please install the C module from CPAN, and pre-encode your URI before passing it to C. You can read about the details of URIs and URI encoding here: http://www.faqs.org/rfcs/rfc2396.html =head1 TODO =over 4 =item Implement $PREFER_BIN To indicate to rather use commandline tools than modules =head1 AUTHORS This module by Jos Boumans Ekane@cpan.orgE. =head1 COPYRIGHT This module is copyright (c) 2003-2007 Jos Boumans Ekane@cpan.orgE. All rights reserved. This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut # Local variables: # c-indentation-style: bsd # c-basic-offset: 4 # indent-tabs-mode: nil # End: # vim: expandtab shiftwidth=4: Alien-wxWidgets-0.69/inc/inc_IPC-Cmd000775000000000000 013075252612 17535 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/inc_IPC-Cmd/IPC000775000000000000 013075252612 20150 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/inc_IPC-Cmd/IPC/Cmd.pm000664000000000000 5613012306621537 21377 0ustar00unknownunknown000000000000package IPC::Cmd; use strict; BEGIN { use constant IS_VMS => $^O eq 'VMS' ? 1 : 0; use constant IS_WIN32 => $^O eq 'MSWin32' ? 1 : 0; use constant IS_WIN98 => (IS_WIN32 and !Win32::IsWinNT()) ? 1 : 0; use Exporter (); use vars qw[ @ISA $VERSION @EXPORT_OK $VERBOSE $DEBUG $USE_IPC_RUN $USE_IPC_OPEN3 $WARN ]; $VERSION = '0.36'; $VERBOSE = 0; $DEBUG = 0; $WARN = 1; $USE_IPC_RUN = IS_WIN32 && !IS_WIN98; $USE_IPC_OPEN3 = not IS_VMS; @ISA = qw[Exporter]; @EXPORT_OK = qw[can_run run]; } require Carp; use Params::Check qw[check]; use Module::Load::Conditional qw[can_load]; use Locale::Maketext::Simple Style => 'gettext'; =pod =head1 NAME IPC::Cmd - finding and running system commands made easy =head1 SYNOPSIS use IPC::Cmd qw[can_run run]; my $full_path = can_run('wget') or warn 'wget is not installed!'; ### commands can be arrayrefs or strings ### my $cmd = "$full_path -b theregister.co.uk"; my $cmd = [$full_path, '-b', 'theregister.co.uk']; ### in scalar context ### my $buffer; if( scalar run( command => $cmd, verbose => 0, buffer => \$buffer ) ) { print "fetched webpage successfully: $buffer\n"; } ### in list context ### my( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run( command => $cmd, verbose => 0 ); if( $success ) { print "this is what the command printed:\n"; print join "", @$full_buf; } ### check for features print "IPC::Open3 available: " . IPC::Cmd->can_use_ipc_open3; print "IPC::Run available: " . IPC::Cmd->can_use_ipc_run; print "Can capture buffer: " . IPC::Cmd->can_capture_buffer; ### don't have IPC::Cmd be verbose, ie don't print to stdout or ### stderr when running commands -- default is '0' $IPC::Cmd::VERBOSE = 0; =head1 DESCRIPTION IPC::Cmd allows you to run commands, interactively if desired, platform independent but have them still work. The C function can tell you if a certain binary is installed and if so where, whereas the C function can actually execute any of the commands you give it and give you a clear return value, as well as adhere to your verbosity settings. =head1 CLASS METHODS =head2 $bool = IPC::Cmd->can_use_ipc_run( [VERBOSE] ) Utility function that tells you if C is available. If the verbose flag is passed, it will print diagnostic messages if C can not be found or loaded. =cut sub can_use_ipc_run { my $self = shift; my $verbose = shift || 0; ### ipc::run doesn't run on win98 return if IS_WIN98; ### if we dont have ipc::run, we obviously can't use it. return unless can_load( modules => { 'IPC::Run' => '0.55' }, verbose => ($WARN && $verbose), ); ### otherwise, we're good to go return 1; } =head2 $bool = IPC::Cmd->can_use_ipc_open3( [VERBOSE] ) Utility function that tells you if C is available. If the verbose flag is passed, it will print diagnostic messages if C can not be found or loaded. =cut sub can_use_ipc_open3 { my $self = shift; my $verbose = shift || 0; ### ipc::open3 works on every platform, but it can't capture buffers ### on win32 :( return unless can_load( modules => { map {$_ => '0.0'} qw|IPC::Open3 IO::Select Symbol| }, verbose => ($WARN && $verbose), ); return 1; } =head2 $bool = IPC::Cmd->can_capture_buffer Utility function that tells you if C is capable of capturing buffers in it's current configuration. =cut sub can_capture_buffer { my $self = shift; return 1 if $USE_IPC_RUN && $self->can_use_ipc_run; return 1 if $USE_IPC_OPEN3 && $self->can_use_ipc_open3 && !IS_WIN32; return; } =head1 FUNCTIONS =head2 $path = can_run( PROGRAM ); C takes but a single argument: the name of a binary you wish to locate. C works much like the unix binary C or the bash command C, which scans through your path, looking for the requested binary . Unlike C and C, this function is platform independent and will also work on, for example, Win32. It will return the full path to the binary you asked for if it was found, or C if it was not. =cut sub can_run { my $command = shift; # a lot of VMS executables have a symbol defined # check those first if ( $^O eq 'VMS' ) { require VMS::DCLsym; my $syms = VMS::DCLsym->new; return $command if scalar $syms->getsym( uc $command ); } require Config; require File::Spec; require ExtUtils::MakeMaker; if( File::Spec->file_name_is_absolute($command) ) { return MM->maybe_command($command); } else { for my $dir (split /\Q$Config::Config{path_sep}\E/, $ENV{PATH}) { my $abs = File::Spec->catfile($dir, $command); return $abs if $abs = MM->maybe_command($abs); } } } =head2 $ok | ($ok, $err, $full_buf, $stdout_buff, $stderr_buff) = run( command => COMMAND, [verbose => BOOL, buffer => \$SCALAR] ); C takes 3 arguments: =over 4 =item command This is the command to execute. It may be either a string or an array reference. This is a required argument. See L for remarks on how commands are parsed and their limitations. =item verbose This controls whether all output of a command should also be printed to STDOUT/STDERR or should only be trapped in buffers (NOTE: buffers require C to be installed or your system able to work with C). It will default to the global setting of C<$IPC::Cmd::VERBOSE>, which by default is 0. =item buffer This will hold all the output of a command. It needs to be a reference to a scalar. Note that this will hold both the STDOUT and STDERR messages, and you have no way of telling which is which. If you require this distinction, run the C command in list context and inspect the individual buffers. Of course, this requires that the underlying call supports buffers. See the note on buffers right above. =back C will return a simple C or C when called in scalar context. In list context, you will be returned a list of the following items: =over 4 =item success A simple boolean indicating if the command executed without errors or not. =item errorcode If the first element of the return value (success) was 0, then some error occurred. This second element is the error code the command you requested exited with, if available. =item full_buffer This is an arrayreference containing all the output the command generated. Note that buffers are only available if you have C installed, or if your system is able to work with C -- See below). This element will be C if this is not the case. =item out_buffer This is an arrayreference containing all the output sent to STDOUT the command generated. Note that buffers are only available if you have C installed, or if your system is able to work with C -- See below). This element will be C if this is not the case. =item error_buffer This is an arrayreference containing all the output sent to STDERR the command generated. Note that buffers are only available if you have C installed, or if your system is able to work with C -- See below). This element will be C if this is not the case. =back See the C Section below to see how C decides what modules or function calls to use when issuing a command. =cut sub run { my %hash = @_; ### if the user didn't provide a buffer, we'll store it here. my $def_buf = ''; my($verbose,$cmd,$buffer); my $tmpl = { verbose => { default => $VERBOSE, store => \$verbose }, buffer => { default => \$def_buf, store => \$buffer }, command => { required => 1, store => \$cmd, allow => sub { !ref($_[0]) or ref($_[0]) eq 'ARRAY' } }, }; unless( check( $tmpl, \%hash, $VERBOSE ) ) { Carp::carp(loc("Could not validate input: %1", Params::Check->last_error)); return; }; print loc("Running [%1]...\n", (ref $cmd ? "@$cmd" : $cmd)) if $verbose; ### did the user pass us a buffer to fill or not? if so, set this ### flag so we know what is expected of us ### XXX this is now being ignored. in the future, we could add diagnostic ### messages based on this logic #my $user_provided_buffer = $buffer == \$def_buf ? 0 : 1; ### buffers that are to be captured my( @buffer, @buff_err, @buff_out ); ### capture STDOUT my $_out_handler = sub { my $buf = shift; return unless defined $buf; print STDOUT $buf if $verbose; push @buffer, $buf; push @buff_out, $buf; }; ### capture STDERR my $_err_handler = sub { my $buf = shift; return unless defined $buf; print STDERR $buf if $verbose; push @buffer, $buf; push @buff_err, $buf; }; ### flag to indicate we have a buffer captured my $have_buffer = __PACKAGE__->can_capture_buffer ? 1 : 0; ### flag indicating if the subcall went ok my $ok; ### IPC::Run is first choice if $USE_IPC_RUN is set. if( $USE_IPC_RUN and __PACKAGE__->can_use_ipc_run( 1 ) ) { ### ipc::run handlers needs the command as a string or an array ref __PACKAGE__->_debug( "# Using IPC::Run. Have buffer: $have_buffer" ) if $DEBUG; $ok = __PACKAGE__->_ipc_run( $cmd, $_out_handler, $_err_handler ); ### since IPC::Open3 works on all platforms, and just fails on ### win32 for capturing buffers, do that ideally } elsif ( $USE_IPC_OPEN3 and __PACKAGE__->can_use_ipc_open3( 1 ) ) { __PACKAGE__->_debug( "# Using IPC::Open3. Have buffer: $have_buffer" ) if $DEBUG; ### in case there are pipes in there; ### IPC::Open3 will call exec and exec will do the right thing $ok = __PACKAGE__->_open3_run( ( ref $cmd ? "@$cmd" : $cmd ), $_out_handler, $_err_handler, $verbose ); ### if we are allowed to run verbose, just dispatch the system command } else { __PACKAGE__->_debug( "# Using system(). Have buffer: $have_buffer" ) if $DEBUG; $ok = __PACKAGE__->_system_run( (ref $cmd ? "@$cmd" : $cmd), $verbose ); } ### fill the buffer; $$buffer = join '', @buffer if @buffer; ### return a list of flags and buffers (if available) in list ### context, or just a simple 'ok' in scalar return wantarray ? $have_buffer ? ($ok, $?, \@buffer, \@buff_out, \@buff_err) : ($ok, $? ) : $ok } sub _open3_run { my $self = shift; my $cmd = shift; my $_out_handler = shift; my $_err_handler = shift; my $verbose = shift || 0; ### Following code are adapted from Friar 'abstracts' in the ### Perl Monastery (http://www.perlmonks.org/index.pl?node_id=151886). ### XXX that code didn't work. ### we now use the following code, thanks to theorbtwo ### define them beforehand, so we always have defined FH's ### to read from. use Symbol; my $kidout = Symbol::gensym(); my $kiderror = Symbol::gensym(); ### Dup the filehandle so we can pass 'our' STDIN to the ### child process. This stops us from having to pump input ### from ourselves to the childprocess. However, we will need ### to revive the FH afterwards, as IPC::Open3 closes it. ### We'll do the same for STDOUT and STDERR. It works without ### duping them on non-unix derivatives, but not on win32. my @fds_to_dup = ( IS_WIN32 && !$verbose ? qw[STDIN STDOUT STDERR] : qw[STDIN] ); __PACKAGE__->__dup_fds( @fds_to_dup ); my $pid = IPC::Open3::open3( '<&STDIN', (IS_WIN32 ? '>&STDOUT' : $kidout), (IS_WIN32 ? '>&STDERR' : $kiderror), $cmd ); ### use OUR stdin, not $kidin. Somehow, ### we never get the input.. so jump through ### some hoops to do it :( my $selector = IO::Select->new( (IS_WIN32 ? \*STDERR : $kiderror), \*STDIN, (IS_WIN32 ? \*STDOUT : $kidout) ); STDOUT->autoflush(1); STDERR->autoflush(1); STDIN->autoflush(1); $kidout->autoflush(1) if UNIVERSAL::can($kidout, 'autoflush'); $kiderror->autoflush(1) if UNIVERSAL::can($kiderror, 'autoflush'); ### add an epxlicit break statement ### code courtesy of theorbtwo from #london.pm OUTER: while ( my @ready = $selector->can_read ) { for my $h ( @ready ) { my $buf; ### $len is the amount of bytes read my $len = sysread( $h, $buf, 4096 ); # try to read 4096 bytes ### see perldoc -f sysread: it returns undef on error, ### so bail out. if( not defined $len ) { warn(loc("Error reading from process: %1", $!)); last OUTER; } ### check for $len. it may be 0, at which point we're ### done reading, so don't try to process it. ### if we would print anyway, we'd provide bogus information $_out_handler->( "$buf" ) if $len && $h == $kidout; $_err_handler->( "$buf" ) if $len && $h == $kiderror; ### child process is done printing. last OUTER if $h == $kidout and $len == 0 } } waitpid $pid, 0; # wait for it to die ### restore STDIN after duping, or STDIN will be closed for ### this current perl process! __PACKAGE__->__reopen_fds( @fds_to_dup ); return if $?; # some error occurred return 1; } sub _ipc_run { my $self = shift; my $cmd = shift; my $_out_handler = shift; my $_err_handler = shift; STDOUT->autoflush(1); STDERR->autoflush(1); ### a command like: # [ # '/usr/bin/gzip', # '-cdf', # '/Users/kane/sources/p4/other/archive-extract/t/src/x.tgz', # '|', # '/usr/bin/tar', # '-tf -' # ] ### needs to become: # [ # ['/usr/bin/gzip', '-cdf', # '/Users/kane/sources/p4/other/archive-extract/t/src/x.tgz'] # '|', # ['/usr/bin/tar', '-tf -'] # ] my @command; my $special_chars; if( ref $cmd ) { my $aref = []; for my $item (@$cmd) { if( $item =~ /([<>|&])/ ) { push @command, $aref, $item; $aref = []; $special_chars .= $1; } else { push @$aref, $item; } } push @command, $aref; } else { @command = map { if( /([<>|&])/ ) { $special_chars .= $1; $_; } else { [ split / +/ ] } } split( /\s*([<>|&])\s*/, $cmd ); } ### if there's a pipe in the command, *STDIN needs to ### be inserted *BEFORE* the pipe, to work on win32 ### this also works on *nix, so we should do it when possible ### this should *also* work on multiple pipes in the command ### if there's no pipe in the command, append STDIN to the back ### of the command instead. ### XXX seems IPC::Run works it out for itself if you just ### dont pass STDIN at all. # if( $special_chars and $special_chars =~ /\|/ ) { # ### only add STDIN the first time.. # my $i; # @command = map { ($_ eq '|' && not $i++) # ? ( \*STDIN, $_ ) # : $_ # } @command; # } else { # push @command, \*STDIN; # } # \*STDIN is already included in the @command, see a few lines up return IPC::Run::run( @command, fileno(STDOUT).'>', $_out_handler, fileno(STDERR).'>', $_err_handler ); } sub _system_run { my $self = shift; my $cmd = shift; my $verbose = shift || 0; my @fds_to_dup = $verbose ? () : qw[STDOUT STDERR]; __PACKAGE__->__dup_fds( @fds_to_dup ); ### system returns 'true' on failure -- the exit code of the cmd system( $cmd ); __PACKAGE__->__reopen_fds( @fds_to_dup ); return if $?; return 1; } { use File::Spec; use Symbol; my %Map = ( STDOUT => [qw|>&|, \*STDOUT, Symbol::gensym() ], STDERR => [qw|>&|, \*STDERR, Symbol::gensym() ], STDIN => [qw|<&|, \*STDIN, Symbol::gensym() ], ); ### dups FDs and stores them in a cache sub __dup_fds { my $self = shift; my @fds = @_; __PACKAGE__->_debug( "# Closing the following fds: @fds" ) if $DEBUG; for my $name ( @fds ) { my($redir, $fh, $glob) = @{$Map{$name}} or ( Carp::carp(loc("No such FD: '%1'", $name)), next ); ### MUST use the 2-arg version of open for dup'ing for ### 5.6.x compatibilty. 5.8.x can use 3-arg open ### see perldoc5.6.2 -f open for details open $glob, $redir . fileno($fh) or ( Carp::carp(loc("Could not dup '$name': %1", $!)), return ); ### we should re-open this filehandle right now, not ### just dup it if( $redir eq '>&' ) { open( $fh, '>', File::Spec->devnull ) or ( Carp::carp(loc("Could not reopen '$name': %1", $!)), return ); } } return 1; } ### reopens FDs from the cache sub __reopen_fds { my $self = shift; my @fds = @_; __PACKAGE__->_debug( "# Reopening the following fds: @fds" ) if $DEBUG; for my $name ( @fds ) { my($redir, $fh, $glob) = @{$Map{$name}} or ( Carp::carp(loc("No such FD: '%1'", $name)), next ); ### MUST use the 2-arg version of open for dup'ing for ### 5.6.x compatibilty. 5.8.x can use 3-arg open ### see perldoc5.6.2 -f open for details open( $fh, $redir . fileno($glob) ) or ( Carp::carp(loc("Could not restore '$name': %1", $!)), return ); ### close this FD, we're not using it anymore close $glob; } return 1; } } sub _debug { my $self = shift; my $msg = shift or return; my $level = shift || 0; local $Carp::CarpLevel += $level; Carp::carp($msg); return 1; } 1; __END__ =head1 HOW IT WORKS C will try to execute your command using the following logic: =over 4 =item * If you have C installed, and the variable C<$IPC::Cmd::USE_IPC_RUN> is set to true (See the C Section) use that to execute the command. You will have the full output available in buffers, interactive commands are sure to work and you are guaranteed to have your verbosity settings honored cleanly. =item * Otherwise, if the variable C<$IPC::Cmd::USE_IPC_OPEN3> is set to true (See the C Section), try to execute the command using C. Buffers will be available on all platforms except C, interactive commands will still execute cleanly, and also your verbosity settings will be adhered to nicely; =item * Otherwise, if you have the verbose argument set to true, we fall back to a simple system() call. We cannot capture any buffers, but interactive commands will still work. =item * Otherwise we will try and temporarily redirect STDERR and STDOUT, do a system() call with your command and then re-open STDERR and STDOUT. This is the method of last resort and will still allow you to execute your commands cleanly. However, no buffers will be available. =back =head1 Global Variables The behaviour of IPC::Cmd can be altered by changing the following global variables: =head2 $IPC::Cmd::VERBOSE This controls whether IPC::Cmd will print any output from the commands to the screen or not. The default is 0; =head2 $IPC::Cmd::USE_IPC_RUN This variable controls whether IPC::Cmd will try to use L when available and suitable. Defaults to true if you are on C. =head2 $IPC::Cmd::USE_IPC_OPEN3 This variable controls whether IPC::Cmd will try to use L when available and suitable. Defaults to true. =head2 $IPC::Cmd::WARN This variable controls whether run time warnings should be issued, like the failure to load an C module you explicitly requested. Defaults to true. Turn this off at your own risk. =head1 Caveats =over 4 =item Whitespace When you provide a string as this argument, the string will be split on whitespace to determine the individual elements of your command. Although this will usually just Do What You Mean, it may break if you have files or commands with whitespace in them. If you do not wish this to happen, you should provide an array reference, where all parts of your command are already separated out. Note however, if there's extra or spurious whitespace in these parts, the parser or underlying code may not interpret it correctly, and cause an error. Example: The following code gzip -cdf foo.tar.gz | tar -xf - should either be passed as "gzip -cdf foo.tar.gz | tar -xf -" or as ['gzip', '-cdf', 'foo.tar.gz', '|', 'tar', '-xf', '-'] But take care not to pass it as, for example ['gzip -cdf foo.tar.gz', '|', 'tar -xf -'] Since this will lead to issues as described above. =item IO Redirect Currently it is too complicated to parse your command for IO Redirections. For capturing STDOUT or STDERR there is a work around however, since you can just inspect your buffers for the contents. =back =head1 See Also C, C =head1 AUTHOR This module by Jos Boumans Ekane@cpan.orgE. =head1 ACKNOWLEDGEMENTS Thanks to James Mastros and Martijn van der Streek for their help in getting IPC::Open3 to behave nicely. =head1 COPYRIGHT This module is copyright (c) 2002 - 2006 Jos Boumans Ekane@cpan.orgE. All rights reserved. This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. Alien-wxWidgets-0.69/inc/inc_Locale-Maketext-Simple000775000000000000 013075252613 22630 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/inc_Locale-Maketext-Simple/Locale000775000000000000 013075252613 24027 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/inc_Locale-Maketext-Simple/Locale/Maketext000775000000000000 013075252613 25611 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/inc_Locale-Maketext-Simple/Locale/Maketext/Simple.pm000664000000000000 2250112306621537 27560 0ustar00unknownunknown000000000000package Locale::Maketext::Simple; $Locale::Maketext::Simple::VERSION = '0.18'; use strict; use 5.004; =head1 NAME Locale::Maketext::Simple - Simple interface to Locale::Maketext::Lexicon =head1 VERSION This document describes version 0.18 of Locale::Maketext::Simple, released Septermber 8, 2006. =head1 SYNOPSIS Minimal setup (looks for F and F): package Foo; use Locale::Maketext::Simple; # exports 'loc' loc_lang('fr'); # set language to French sub hello { print loc("Hello, [_1]!", "World"); } More sophisticated example: package Foo::Bar; use Locale::Maketext::Simple ( Class => 'Foo', # search in auto/Foo/ Style => 'gettext', # %1 instead of [_1] Export => 'maketext', # maketext() instead of loc() Subclass => 'L10N', # Foo::L10N instead of Foo::I18N Decode => 1, # decode entries to unicode-strings Encoding => 'locale', # but encode lexicons in current locale # (needs Locale::Maketext::Lexicon 0.36) ); sub japh { print maketext("Just another %1 hacker", "Perl"); } =head1 DESCRIPTION This module is a simple wrapper around B, designed to alleviate the need of creating I for module authors. If B is not present, it implements a minimal localization function by simply interpolating C<[_1]> with the first argument, C<[_2]> with the second, etc. Interpolated function like C<[quant,_1]> are treated as C<[_1]>, with the sole exception of C<[tense,_1,X]>, which will append C to C<_1> when X is C, or appending C to <_1> otherwise. =head1 OPTIONS All options are passed either via the C statement, or via an explicit C. =head2 Class By default, B draws its source from the calling package's F directory; you can override this behaviour by explicitly specifying another package as C. =head2 Path If your PO and MO files are under a path elsewhere than C, you may specify it using the C option. =head2 Style By default, this module uses the C style of C<[_1]> and C<[quant,_1]> for interpolation. Alternatively, you can specify the C style, which uses C<%1> and C<%quant(%1)> for interpolation. This option is case-insensitive. =head2 Export By default, this module exports a single function, C, into its caller's namespace. You can set it to another name, or set it to an empty string to disable exporting. =head2 Subclass By default, this module creates an C<::I18N> subclass under the caller's package (or the package specified by C), and stores lexicon data in its subclasses. You can assign a name other than C via this option. =head2 Decode If set to a true value, source entries will be converted into utf8-strings (available in Perl 5.6.1 or later). This feature needs the B or B module. =head2 Encoding Specifies an encoding to store lexicon entries, instead of utf8-strings. If set to C, the encoding from the current locale setting is used. Implies a true value for C. =cut sub import { my ($class, %args) = @_; $args{Class} ||= caller; $args{Style} ||= 'maketext'; $args{Export} ||= 'loc'; $args{Subclass} ||= 'I18N'; my ($loc, $loc_lang) = $class->load_loc(%args); $loc ||= $class->default_loc(%args); no strict 'refs'; *{caller(0) . "::$args{Export}"} = $loc if $args{Export}; *{caller(0) . "::$args{Export}_lang"} = $loc_lang || sub { 1 }; } my %Loc; sub reload_loc { %Loc = () } sub load_loc { my ($class, %args) = @_; my $pkg = join('::', grep { defined and length } $args{Class}, $args{Subclass}); return $Loc{$pkg} if exists $Loc{$pkg}; eval { require Locale::Maketext::Lexicon; 1 } or return; $Locale::Maketext::Lexicon::VERSION > 0.20 or return; eval { require File::Spec; 1 } or return; my $path = $args{Path} || $class->auto_path($args{Class}) or return; my $pattern = File::Spec->catfile($path, '*.[pm]o'); my $decode = $args{Decode} || 0; my $encoding = $args{Encoding} || undef; $decode = 1 if $encoding; $pattern =~ s{\\}{/}g; # to counter win32 paths eval " package $pkg; use base 'Locale::Maketext'; %${pkg}::Lexicon = ( '_AUTO' => 1 ); Locale::Maketext::Lexicon->import({ 'i-default' => [ 'Auto' ], '*' => [ Gettext => \$pattern ], _decode => \$decode, _encoding => \$encoding, }); *tense = sub { \$_[1] . ((\$_[2] eq 'present') ? 'ing' : 'ed') } unless defined &tense; 1; " or die $@; my $lh = eval { $pkg->get_handle } or return; my $style = lc($args{Style}); if ($style eq 'maketext') { $Loc{$pkg} = sub { $lh->maketext(@_) }; } elsif ($style eq 'gettext') { $Loc{$pkg} = sub { my $str = shift; $str =~ s{([\~\[\]])}{~$1}g; $str =~ s{ ([%\\]%) # 1 - escaped sequence | % (?: ([A-Za-z#*]\w*) # 2 - function call \(([^\)]*)\) # 3 - arguments | ([1-9]\d*|\*) # 4 - variable ) }{ $1 ? $1 : $2 ? "\[$2,"._unescape($3)."]" : "[_$4]" }egx; return $lh->maketext($str, @_); }; } else { die "Unknown Style: $style"; } return $Loc{$pkg}, sub { $lh = $pkg->get_handle(@_); $lh = $pkg->get_handle(@_); }; } sub default_loc { my ($self, %args) = @_; my $style = lc($args{Style}); if ($style eq 'maketext') { return sub { my $str = shift; $str =~ s{((? 1) ? ($4 || "$3s") : $3) : '' ) : '' ); }egx; return $str; }; sub _escape { my $text = shift; $text =~ s/\b_([1-9]\d*)/%$1/g; return $text; } sub _unescape { join(',', map { /\A(\s*)%([1-9]\d*|\*)(\s*)\z/ ? "$1_$2$3" : $_ } split(/,/, $_[0])); } sub auto_path { my ($self, $calldir) = @_; $calldir =~ s#::#/#g; my $path = $INC{$calldir . '.pm'} or return; # Try absolute path name. if ($^O eq 'MacOS') { (my $malldir = $calldir) =~ tr#/#:#; $path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:#s; } else { $path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/#; } return $path if -d $path; # If that failed, try relative path with normal @INC searching. $path = "auto/$calldir/"; foreach my $inc (@INC) { return "$inc/$path" if -d "$inc/$path"; } return; } 1; =head1 ACKNOWLEDGMENTS Thanks to Jos I. Boumans for suggesting this module to be written. Thanks to Chia-Liang Kao for suggesting C and C. =head1 SEE ALSO L, L =head1 AUTHORS Audrey Tang Ecpan@audreyt.orgE =head1 COPYRIGHT Copyright 2003, 2004, 2005, 2006 by Audrey Tang Ecpan@audreyt.orgE. This software is released under the MIT license cited below. Additionally, when this software is distributed with B, you may also redistribute it and/or modify it under the same terms as Perl itself. =head2 The "MIT" License Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =cut Alien-wxWidgets-0.69/inc/inc_Module-Load000775000000000000 013075252613 20524 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/inc_Module-Load/Module000775000000000000 013075252613 21751 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/inc_Module-Load/Module/Load.pm000664000000000000 1027012306621540 23340 0ustar00unknownunknown000000000000package Module::Load; $VERSION = '0.10'; use strict; use File::Spec (); sub import { my $who = _who(); { no strict 'refs'; *{"${who}::load"} = *load; } } sub load (*;@) { my $mod = shift or return; my $who = _who(); if( _is_file( $mod ) ) { require $mod; } else { LOAD: { my $err; for my $flag ( qw[1 0] ) { my $file = _to_file( $mod, $flag); eval { require $file }; $@ ? $err .= $@ : last LOAD; } die $err if $err; } } __PACKAGE__->_export_to_level(1, $mod, @_) if @_; } ### 5.004's Exporter doesn't have export_to_level. ### Taken from Michael Schwerns Test::More and slightly modified sub _export_to_level { my $pkg = shift; my $level = shift; my $mod = shift; my $callpkg = caller($level); $mod->export($callpkg, @_); } sub _to_file{ local $_ = shift; my $pm = shift || ''; my @parts = split /::/; ### because of [perl #19213], see caveats ### my $file = $^O eq 'MSWin32' ? join "/", @parts : File::Spec->catfile( @parts ); $file .= '.pm' if $pm; return $file; } sub _who { (caller(1))[0] } sub _is_file { local $_ = shift; return /^\./ ? 1 : /[^\w:']/ ? 1 : undef #' silly bbedit.. } 1; __END__ =pod =head1 NAME Module::Load - runtime require of both modules and files =head1 SYNOPSIS use Module::Load; my $module = 'Data:Dumper'; load Data::Dumper; # loads that module load 'Data::Dumper'; # ditto load $module # tritto my $script = 'some/script.pl' load $script; load 'some/script.pl'; # use quotes because of punctuations load thing; # try 'thing' first, then 'thing.pm' load CGI, ':standard' # like 'use CGI qw[:standard]' =head1 DESCRIPTION C eliminates the need to know whether you are trying to require either a file or a module. If you consult C you will see that C will behave differently when given a bareword or a string. In the case of a string, C assumes you are wanting to load a file. But in the case of a bareword, it assumes you mean a module. This gives nasty overhead when you are trying to dynamically require modules at runtime, since you will need to change the module notation (C) to a file notation fitting the particular platform you are on. C elimates the need for this overhead and will just DWYM. =head1 Rules C has the following rules to decide what it thinks you want: =over 4 =item * If the argument has any characters in it other than those matching C<\w>, C<:> or C<'>, it must be a file =item * If the argument matches only C<[\w:']>, it must be a module =item * If the argument matches only C<\w>, it could either be a module or a file. We will try to find C first in C<@INC> and if that fails, we will try to find C in @INC. If both fail, we die with the respective error messages. =back =head1 Caveats Because of a bug in perl (#19213), at least in version 5.6.1, we have to hardcode the path seperator for a require on Win32 to be C, like on Unix rather than the Win32 C<\>. Otherwise perl will not read it's own %INC accurately double load files if they are required again, or in the worst case, core dump. C can not do implicit imports, only explicit imports. (in other words, you always have to specify expliclity what you wish to import from a module, even if the functions are in that modules' C<@EXPORT>) =head1 AUTHOR This module by Jos Boumans Ekane@cpan.orgE. Thanks to Jonas B. Nielsen for making explicit imports work. =head1 COPYRIGHT This module is copyright (c) 2002 Jos Boumans Ekane@cpan.orgE. All rights reserved. This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut Alien-wxWidgets-0.69/inc/inc_Module-Load-Conditional000775000000000000 013075252613 22765 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/inc_Module-Load-Conditional/Module000775000000000000 013075252613 24212 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/inc_Module-Load-Conditional/Module/Load000775000000000000 013075252613 25071 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/inc_Module-Load-Conditional/Module/Load/Conditional.pm000664000000000000 4176012306621540 30054 0ustar00unknownunknown000000000000package Module::Load::Conditional; use strict; use Module::Load; use Params::Check qw[check]; use Locale::Maketext::Simple Style => 'gettext'; use Carp (); use File::Spec (); use FileHandle (); use version qw[qv]; BEGIN { use vars qw[ $VERSION @ISA $VERBOSE $CACHE @EXPORT_OK $FIND_VERSION $ERROR $CHECK_INC_HASH]; use Exporter; @ISA = qw[Exporter]; $VERSION = '0.16'; $VERBOSE = 0; $FIND_VERSION = 1; $CHECK_INC_HASH = 0; @EXPORT_OK = qw[check_install can_load requires]; } =pod =head1 NAME Module::Load::Conditional - Looking up module information / loading at runtime =head1 SYNOPSIS use Module::Load::Conditional qw[can_load check_install requires]; my $use_list = { CPANPLUS => 0.05, LWP => 5.60, 'Test::More' => undef, }; print can_load( modules => $use_list ) ? 'all modules loaded successfully' : 'failed to load required modules'; my $rv = check_install( module => 'LWP', version => 5.60 ) or print 'LWP is not installed!'; print 'LWP up to date' if $rv->{uptodate}; print "LWP version is $rv->{version}\n"; print "LWP is installed as file $rv->{file}\n"; print "LWP requires the following modules to be installed:\n"; print join "\n", requires('LWP'); ### allow M::L::C to peek in your %INC rather than just ### scanning @INC $Module::Load::Conditional::CHECK_INC_HASH = 1; ### reset the 'can_load' cache undef $Module::Load::Conditional::CACHE; ### don't have Module::Load::Conditional issue warnings -- ### default is '1' $Module::Load::Conditional::VERBOSE = 0; ### The last error that happened during a call to 'can_load' my $err = $Module::Load::Conditional::ERROR; =head1 DESCRIPTION Module::Load::Conditional provides simple ways to query and possibly load any of the modules you have installed on your system during runtime. It is able to load multiple modules at once or none at all if one of them was not able to load. It also takes care of any error checking and so forth. =head1 Methods =head1 $href = check_install( module => NAME [, version => VERSION, verbose => BOOL ] ); C allows you to verify if a certain module is installed or not. You may call it with the following arguments: =over 4 =item module The name of the module you wish to verify -- this is a required key =item version The version this module needs to be -- this is optional =item verbose Whether or not to be verbose about what it is doing -- it will default to $Module::Load::Conditional::VERBOSE =back It will return undef if it was not able to find where the module was installed, or a hash reference with the following keys if it was able to find the file: =over 4 =item file Full path to the file that contains the module =item version The version number of the installed module - this will be C if the module had no (or unparsable) version number, or if the variable C<$Module::Load::Conditional::FIND_VERSION> was set to true. (See the C section below for details) =item uptodate A boolean value indicating whether or not the module was found to be at least the version you specified. If you did not specify a version, uptodate will always be true if the module was found. If no parsable version was found in the module, uptodate will also be true, since C had no way to verify clearly. =back =cut ### this checks if a certain module is installed already ### ### if it returns true, the module in question is already installed ### or we found the file, but couldn't open it, OR there was no version ### to be found in the module ### it will return 0 if the version in the module is LOWER then the one ### we are looking for, or if we couldn't find the desired module to begin with ### if the installed version is higher or equal to the one we want, it will return ### a hashref with he module name and version in it.. so 'true' as well. sub check_install { my %hash = @_; my $tmpl = { version => { default => '0.0' }, module => { required => 1 }, verbose => { default => $VERBOSE }, }; my $args; unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) { warn loc( q[A problem occurred checking arguments] ) if $VERBOSE; return; } my $file = File::Spec->catfile( split /::/, $args->{module} ) . '.pm'; my $file_inc = File::Spec::Unix->catfile( split /::/, $args->{module} ) . '.pm'; ### where we store the return value ### my $href = { file => undef, version => undef, uptodate => undef, }; my $filename; ### check the inc hash if we're allowed to if( $CHECK_INC_HASH ) { $filename = $href->{'file'} = $INC{ $file_inc } if defined $INC{ $file_inc }; ### find the version by inspecting the package if( defined $filename && $FIND_VERSION ) { no strict 'refs'; $href->{version} = ${ "$args->{module}"."::VERSION" }; } } ### we didnt find the filename yet by looking in %INC, ### so scan the dirs unless( $filename ) { DIR: for my $dir ( @INC ) { my $fh; if ( ref $dir ) { ### @INC hook -- we invoke it and get the filehandle back ### this is actually documented behaviour as of 5.8 ;) if (UNIVERSAL::isa($dir, 'CODE')) { ($fh) = $dir->($dir, $file); } elsif (UNIVERSAL::isa($dir, 'ARRAY')) { ($fh) = $dir->[0]->($dir, $file, @{$dir}{1..$#{$dir}}) } elsif (UNIVERSAL::can($dir, 'INC')) { ($fh) = $dir->INC->($dir, $file); } if (!UNIVERSAL::isa($fh, 'GLOB')) { warn loc(q[Cannot open file '%1': %2], $file, $!) if $args->{verbose}; next; } $filename = $INC{$file_inc} || $file; } else { $filename = File::Spec->catfile($dir, $file); next unless -e $filename; $fh = new FileHandle; if (!$fh->open($filename)) { warn loc(q[Cannot open file '%1': %2], $file, $!) if $args->{verbose}; next; } } $href->{file} = $filename; ### user wants us to find the version from files if( $FIND_VERSION ) { my $in_pod = 0; while (local $_ = <$fh> ) { ### stolen from EU::MM_Unix->parse_version to address ### #24062: "Problem with CPANPLUS 0.076 misidentifying ### versions after installing Text::NSP 1.03" where a ### VERSION mentioned in the POD was found before ### the real $VERSION declaration. $in_pod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $in_pod; next if $in_pod; ### try to find a version declaration in this string. my $ver = __PACKAGE__->_parse_version( $_ ); if( defined $ver ) { $href->{version} = $ver; last DIR; } } } } } ### if we couldn't find the file, return undef ### return unless defined $href->{file}; ### only complain if we expected fo find a version higher than 0.0 anyway if( $FIND_VERSION and not defined $href->{version} ) { { ### don't warn about the 'not numeric' stuff ### local $^W; ### if we got here, we didn't find the version warn loc(q[Could not check version on '%1'], $args->{module} ) if $args->{verbose} and $args->{version} > 0; } $href->{uptodate} = 1; } else { ### don't warn about the 'not numeric' stuff ### local $^W; $href->{uptodate} = $args->{version} <= $href->{version} ? 1 : 0; } return $href; } sub _parse_version { my $self = shift; my $str = shift or return; my $verbose = shift or 0; ### skip commented out lines, they won't eval to anything. return if $str =~ /^\s*#/; ### the following regexp & eval statement comes from the ### ExtUtils::MakeMaker source (EU::MM_Unix->parse_version) ### Following #18892, which tells us the original ### regex breaks under -T, we must modifiy it so ### it captures the entire expression, and eval /that/ ### rather than $_, which is insecure. if( $str =~ /(? { NAME => VERSION [,NAME => VERSION] }, [verbose => BOOL, nocache => BOOL] ) C will take a list of modules, optionally with version numbers and determine if it is able to load them. If it can load *ALL* of them, it will. If one or more are unloadable, none will be loaded. This is particularly useful if you have More Than One Way (tm) to solve a problem in a program, and only wish to continue down a path if all modules could be loaded, and not load them if they couldn't. This function uses the C function from Module::Load under the hood. C takes the following arguments: =over 4 =item modules This is a hashref of module/version pairs. The version indicates the minimum version to load. If no version is provided, any version is assumed to be good enough. =item verbose This controls whether warnings should be printed if a module failed to load. The default is to use the value of $Module::Load::Conditional::VERBOSE. =item nocache C keeps its results in a cache, so it will not load the same module twice, nor will it attempt to load a module that has already failed to load before. By default, C will check its cache, but you can override that by setting C to true. =cut sub can_load { my %hash = @_; my $tmpl = { modules => { default => {}, strict_type => 1 }, verbose => { default => $VERBOSE }, nocache => { default => 0 }, }; my $args; unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) { $ERROR = loc(q[Problem validating arguments!]); warn $ERROR if $VERBOSE; return; } ### layout of $CACHE: ### $CACHE = { ### $ module => { ### usable => BOOL, ### version => \d, ### file => /path/to/file, ### }, ### }; $CACHE ||= {}; # in case it was undef'd my $error; BLOCK: { my $href = $args->{modules}; my @load; for my $mod ( keys %$href ) { next if $CACHE->{$mod}->{usable} && !$args->{nocache}; ### else, check if the hash key is defined already, ### meaning $mod => 0, ### indicating UNSUCCESSFUL prior attempt of usage if ( !$args->{nocache} && defined $CACHE->{$mod}->{usable} && (($CACHE->{$mod}->{version}||0) >= $href->{$mod}) ) { $error = loc( q[Already tried to use '%1', which was unsuccessful], $mod); last BLOCK; } my $mod_data = check_install( module => $mod, version => $href->{$mod} ); if( !$mod_data or !defined $mod_data->{file} ) { $error = loc(q[Could not find or check module '%1'], $mod); $CACHE->{$mod}->{usable} = 0; last BLOCK; } map { $CACHE->{$mod}->{$_} = $mod_data->{$_} } qw[version file uptodate]; push @load, $mod; } for my $mod ( @load ) { if ( $CACHE->{$mod}->{uptodate} ) { eval { load $mod }; ### in case anything goes wrong, log the error, the fact ### we tried to use this module and return 0; if( $@ ) { $error = $@; $CACHE->{$mod}->{usable} = 0; last BLOCK; } else { $CACHE->{$mod}->{usable} = 1; } ### module not found in @INC, store the result in ### $CACHE and return 0 } else { $error = loc(q[Module '%1' is not uptodate!], $mod); $CACHE->{$mod}->{usable} = 0; last BLOCK; } } } # BLOCK if( defined $error ) { $ERROR = $error; Carp::carp( loc(q|%1 [THIS MAY BE A PROBLEM!]|,$error) ) if $args->{verbose}; return undef; } else { return 1; } } =head2 @list = requires( MODULE ); C can tell you what other modules a particular module requires. This is particularly useful when you're intending to write a module for public release and are listing its prerequisites. C takes but one argument: the name of a module. It will then first check if it can actually load this module, and return undef if it can't. Otherwise, it will return a list of modules and pragmas that would have been loaded on the module's behalf. Note: The list C returns has originated from your current perl and your current install. =cut sub requires { my $who = shift; unless( check_install( module => $who ) ) { warn loc(q[You do not have module '%1' installed], $who) if $VERBOSE; return undef; } my $lib = join " ", map { qq["-I$_"] } @INC; my $cmd = qq[$^X $lib -M$who -e"print(join(qq[\\n],keys(%INC)))"]; return sort grep { !/^$who$/ } map { chomp; s|/|::|g; $_ } grep { s|\.pm$||i; } `$cmd`; } 1; __END__ =head1 Global Variables The behaviour of Module::Load::Conditional can be altered by changing the following global variables: =head2 $Module::Load::Conditional::VERBOSE This controls whether Module::Load::Conditional will issue warnings and explanations as to why certain things may have failed. If you set it to 0, Module::Load::Conditional will not output any warnings. The default is 0; =head2 $Module::Load::Conditional::FIND_VERSION This controls whether Module::Load::Conditional will try to parse (and eval) the version from the module you're trying to load. If you don't wish to do this, set this variable to C. Understand then that version comparisons are not possible, and Module::Load::Conditional can not tell you what module version you have installed. This may be desirable from a security or performance point of view. Note that C<$FIND_VERSION> code runs safely under C. The default is 1; =head2 $Module::Load::Conditional::CHECK_INC_HASH This controls whether C checks your C<%INC> hash to see if a module is available. By default, only C<@INC> is scanned to see if a module is physically on your filesystem, or avialable via an C<@INC-hook>. Setting this variable to C will trust any entries in C<%INC> and return them for you. The default is 0; =head2 $Module::Load::Conditional::CACHE This holds the cache of the C function. If you explicitly want to remove the current cache, you can set this variable to C =head2 $Module::Load::Conditional::ERROR This holds a string of the last error that happened during a call to C. It is useful to inspect this when C returns C. =head1 See Also C =head1 AUTHOR This module by Jos Boumans Ekane@cpan.orgE. =head1 COPYRIGHT This module is copyright (c) 2002-2007 Jos Boumans Ekane@cpan.orgE. All rights reserved. This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. Alien-wxWidgets-0.69/inc/inc_Params-Check000775000000000000 013075252613 20660 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/inc_Params-Check/Params000775000000000000 013075252613 22103 5ustar00unknownunknown000000000000Alien-wxWidgets-0.69/inc/inc_Params-Check/Params/Check.pm000664000000000000 4627712306621537 23656 0ustar00unknownunknown000000000000package Params::Check; use strict; use Carp qw[carp croak]; use Locale::Maketext::Simple Style => 'gettext'; use Data::Dumper; BEGIN { use Exporter (); use vars qw[ @ISA $VERSION @EXPORT_OK $VERBOSE $ALLOW_UNKNOWN $STRICT_TYPE $STRIP_LEADING_DASHES $NO_DUPLICATES $PRESERVE_CASE $ONLY_ALLOW_DEFINED $WARNINGS_FATAL $SANITY_CHECK_TEMPLATE $CALLER_DEPTH ]; @ISA = qw[ Exporter ]; @EXPORT_OK = qw[check allow last_error]; $VERSION = '0.25'; $VERBOSE = $^W ? 1 : 0; $NO_DUPLICATES = 0; $STRIP_LEADING_DASHES = 0; $STRICT_TYPE = 0; $ALLOW_UNKNOWN = 0; $PRESERVE_CASE = 0; $ONLY_ALLOW_DEFINED = 0; $SANITY_CHECK_TEMPLATE = 1; $WARNINGS_FATAL = 0; $CALLER_DEPTH = 0; } my %known_keys = map { $_ => 1 } qw| required allow default strict_type no_override store defined |; =pod =head1 NAME Params::Check -- A generic input parsing/checking mechanism. =head1 SYNOPSIS use Params::Check qw[check allow last_error]; sub fill_personal_info { my %hash = @_; my $x; my $tmpl = { firstname => { required => 1, defined => 1 }, lastname => { required => 1, store => \$x }, gender => { required => 1, allow => [qr/M/i, qr/F/i], }, married => { allow => [0,1] }, age => { default => 21, allow => qr/^\d+$/, }, phone => { allow => [ sub { return 1 if /$valid_re/ }, '1-800-PERL' ] }, id_list => { default => [], strict_type => 1 }, employer => { default => 'NSA', no_override => 1 }, }; ### check() returns a hashref of parsed args on success ### my $parsed_args = check( $tmpl, \%hash, $VERBOSE ) or die qw[Could not parse arguments!]; ... other code here ... } my $ok = allow( $colour, [qw|blue green yellow|] ); my $error = Params::Check::last_error(); =head1 DESCRIPTION Params::Check is a generic input parsing/checking mechanism. It allows you to validate input via a template. The only requirement is that the arguments must be named. Params::Check can do the following things for you: =over 4 =item * Convert all keys to lowercase =item * Check if all required arguments have been provided =item * Set arguments that have not been provided to the default =item * Weed out arguments that are not supported and warn about them to the user =item * Validate the arguments given by the user based on strings, regexes, lists or even subroutines =item * Enforce type integrity if required =back Most of Params::Check's power comes from its template, which we'll discuss below: =head1 Template As you can see in the synopsis, based on your template, the arguments provided will be validated. The template can take a different set of rules per key that is used. The following rules are available: =over 4 =item default This is the default value if none was provided by the user. This is also the type C will look at when checking type integrity (see below). =item required A boolean flag that indicates if this argument was a required argument. If marked as required and not provided, check() will fail. =item strict_type This does a C check on the argument provided. The C of the argument must be the same as the C of the default value for this check to pass. This is very useful if you insist on taking an array reference as argument for example. =item defined If this template key is true, enforces that if this key is provided by user input, its value is C. This just means that the user is not allowed to pass C as a value for this key and is equivalent to: allow => sub { defined $_[0] && OTHER TESTS } =item no_override This allows you to specify C in your template. ie, they keys that are not allowed to be altered by the user. It pretty much allows you to keep all your C data in one place; the C template. =item store This allows you to pass a reference to a scalar, in which the data will be stored: my $x; my $args = check(foo => { default => 1, store => \$x }, $input); This is basically shorthand for saying: my $args = check( { foo => { default => 1 }, $input ); my $x = $args->{foo}; You can alter the global variable $Params::Check::NO_DUPLICATES to control whether the C'd key will still be present in your result set. See the L section below. =item allow A set of criteria used to validate a particular piece of data if it has to adhere to particular rules. See the C function for details. =back =head1 Functions =head2 check( \%tmpl, \%args, [$verbose] ); This function is not exported by default, so you'll have to ask for it via: use Params::Check qw[check]; or use its fully qualified name instead. C takes a list of arguments, as follows: =over 4 =item Template This is a hashreference which contains a template as explained in the C and C