[Perl-win32-gui-cvscommit] Win32-GUI/Win32-GUI-BitmapInline Makefile.PL, NONE, 1.1 BitmapInline.pm, 1.4, 1.5

[Robert M. <rob...@us...>]

Update of /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-BitmapInline
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24505/Win32-GUI-BitmapInline

Modified Files:
	BitmapInline.pm 
Added Files:
	Makefile.PL 
Log Message:
Re-organisation and bug fixes to BitmapInline

--- NEW FILE: Makefile.PL ---
#!perl -w
use strict;
#use warnings;

# Makefile.PL for Win32::GUI::BitmapInline
# $Id: Makefile.PL,v 1.1 2008/01/13 11:42:57 robertemay Exp $

use 5.006;
use ExtUtils::MakeMaker;

my %config = (
    NAME          =>  'Win32::GUI::BitmapInline',
    VERSION_FROM  =>  'BitmapInline.pm',
    ABSTRACT_FROM =>  'BitmapInline.pm',
    AUTHOR        =>  'Robert May <rob...@us...>',
);

WriteMakefile(%config);

Index: BitmapInline.pm
===================================================================
RCS file: /cvsroot/perl-win32-gui/Win32-GUI/Win32-GUI-BitmapInline/BitmapInline.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** BitmapInline.pm	16 Jul 2006 11:07:04 -0000	1.4
--- BitmapInline.pm	13 Jan 2008 11:42:57 -0000	1.5
***************
*** 1,76 ****
  package Win32::GUI::BitmapInline;
  
! require Exporter;
! @ISA = qw(Exporter);
! @EXPORT = qw(inline);
  
! $VERSION = "0.02";
  $VERSION = eval $VERSION;
  
! $Counter = 1;
  
! require Win32::GUI;
! require MIME::Base64;
  
  sub new {
!     my($class, $data) = @_;
!     open(BMP, ">~$$.tmp") or return undef;
!     binmode(BMP);
!     print BMP MIME::Base64::decode($data);
!     close(BMP); 
!     my $B = new Win32::GUI::Bitmap("~$$.tmp");
!     unlink("~$$.tmp");
!     return $B;  
  }
  
  sub newCursor {
      my($class, $data) = @_;
!     open(BMP, ">~$$.tmp") or return undef;
!     binmode(BMP);
!     print BMP MIME::Base64::decode($data);
!     close(BMP); 
!     my $B = new Win32::GUI::Cursor("~$$.tmp");
!     unlink("~$$.tmp");
!     return $B;  
  }
  
  sub newIcon {
      my($class, $data) = @_;
!     open(BMP, ">~$$.tmp") or return undef;
!     binmode(BMP);
!     print BMP MIME::Base64::decode($data);
!     close(BMP); 
!     my $B = new Win32::GUI::Icon("~$$.tmp");
!     unlink("~$$.tmp");
!     return $B;  
  }
  
! sub inline {
!     my ($file, $name) = @_;
  
!     $name = "Bitmap" . $Win32::GUI::BitmapInline::Counter++ unless $name;
  
!     my $type = "";
!     $file =~ /\.ico$/i and $type = "Icon";
!     $file =~ /\.cur$/i and $type = "Cursor";
  
  
!     open(BMP, $file) or
!         $! = "Bitmap file '$file' not found",
          return undef;
!     my $oldsep = $/;
!     undef $/;
!     binmode(BMP);
!     my $ret = "";
!     $ret .= "\$$name = new$type Win32::GUI::BitmapInline( q(\n";
!     $ret .= MIME::Base64::encode( <BMP> );
      $ret .= ") );\n";
!     close(BMP);
!     $/ = $oldsep;
      print $ret;
      return length($ret);
  }
  
! 1;
  
  __END__
--- 1,173 ----
  package Win32::GUI::BitmapInline;
+ use strict;
+ use warnings;
  
! use Win32::GUI();
! use MIME::Base64(); # Core since ???
! use File::Spec();   # Core since ???
  
! # Make Win32::GUI::BitmapInline thread-safe for ithreads.
! # Stolen from Test::More
! BEGIN {
!     use Config;
!     # Load threads::shared when threads are turned on.
!     # 5.8.0's threads are so busted we no longer support them.
!     if( $] >= 5.008001 && $Config{useithreads} && $INC{'threads.pm'}) {
!         require threads::shared;
! 
!         # Hack around YET ANOTHER threads::shared bug.  It would 
!         # occassionally forget the contents of the variable when sharing it.
!         # So we first copy the data, then share, then put our copy back.
!         *share = sub (\[$@%]) {
!             my $type = ref $_[0];
!             my $data;
! 
!             if( $type eq 'HASH' ) {
!                 %$data = %{$_[0]};
!             }
!             elsif( $type eq 'ARRAY' ) {
!                 @$data = @{$_[0]};
!             }
!             elsif( $type eq 'SCALAR' ) {
!                 $$data = ${$_[0]};
!             }
!             else {
!                 die("Unknown type: ".$type);
!             }
! 
!             $_[0] = &threads::shared::share($_[0]);
! 
!             if( $type eq 'HASH' ) {
!                 %{$_[0]} = %$data;
!             }
!             elsif( $type eq 'ARRAY' ) {
!                 @{$_[0]} = @$data;
!             }
!             elsif( $type eq 'SCALAR' ) {
!                 ${$_[0]} = $$data;
!             }
!             else {
!                 die("Unknown type: ".$type);
!             }
! 
!             return $_[0];
!         };
!     }
!     # 5.8.0's threads::shared is busted when threads are off
!     # and earlier Perls just don't have that module at all.
!     else {
!         *share = sub { return $_[0] };
!         *lock  = sub { 0 };
!     }
! }
! 
! use Exporter();
! our @ISA = qw(Exporter);
! our @EXPORT = qw(inline);
! 
! our $VERSION = "0.02_01";
  $VERSION = eval $VERSION;
  
! # Thread-safe, temporary filename generator
! # We'd like to use File::Temp, but it's not in core.  This
! # is probably good enough
! {
!     my $file_count = 0;
!     share($file_count);
!     sub _tmp_filename {
!         my $count;
!         { lock($file_count); $count = ++$file_count; }
  
!         return "~Win32GUIBitmapInLine.$$.$count.tmp";
!     }
! }
  
+ # new(), defaulting to $type = "Win32::GUI::Bitmap" exists as a public api
+ # for backwards compatibility
  sub new {
!     my($class, $data, $type) = @_;
!     $type = 'Win32::GUI::Bitmap' unless $type;
! 
!     # Find a suitable temp directory.  File::Spec->tmpdir givs us
!     # a writable tmp dir from a list, or the current directory (whether or not
!     # writable) if it can't find a writable directory in any of the usual
!     # places. It'd be nice to use IO::File->new_tmpfile(), but we need the
!     # name of the file to pass to Win32::GUI::Bitmap->new().
!     my $tmpfile = File::Spec->catfile(File::Spec->tmpdir(), _tmp_filename());
! 
!     open(my $tmpfh, '>', $tmpfile);
!     if(!$tmpfh) {
!         warn(qq(Failed to open tmp file '$tmpfile' for writing));
!         return undef;
!     }
! 
!     binmode($tmpfh);
!     print $tmpfh MIME::Base64::decode($data);
!     close($tmpfh) or warn(qq(Failed to close tmp file '$tmpfile')); 
! 
!     my $obj = $type->new($tmpfile);
! 
!     unlink($tmpfile) or warn(qq(Failed to remove tmp file '$tmpfile'));
! 
!     return $obj;  
  }
  
  sub newCursor {
      my($class, $data) = @_;
! 
!     return $class->new($data, 'Win32::GUI::Cursor');
  }
  
  sub newIcon {
      my($class, $data) = @_;
! 
!     return $class->new($data, 'Win32::GUI::Icon');
  }
  
! # Thread-safe counter
! {
!     my $object_count = 0;
!     share($object_count);
!     sub _new_count {
!         my $count;
!         {lock($object_count); $count = ++$object_count; }
!         return $count;
!     }
! }
  
! sub inline {
!     my ($filename, $name) = @_;
  
!     my $type = 'Bitmap';
!     $type = 'Icon'   if $filename =~ /\.ico$/i;
!     $type = 'Cursor' if $filename =~ /\.cur$/i;
  
+     $name = $type . _new_count() unless $name;
  
!     my $bmpfh;
!     if(!open($bmpfh, '<', $filename)) {
!         warn (qq(Can't open file '$filename' for reading));
          return undef;
!     }
!     binmode($bmpfh);
! 
!     # use new() (not newBitmap()) for backwards compatability
!     $type = q() if $type eq 'Bitmap';
!     my $ret = "\$$name = Win32::GUI::BitmapInline->new$type( q(\n";
!     {
!         local $/ = undef; # Slurp
!         $ret .= MIME::Base64::encode( <$bmpfh> );
!     }
      $ret .= ") );\n";
! 
!     close($bmpfh) or warn(qq(Failed to close '$filename')); 
! 
!     # print to currrently selected output filehandle
      print $ret;
+ 
      return length($ret);
  }
  
! 1; # End of BitmapInline.pm
  
  __END__
***************
*** 84,95 ****
  To create a BitmapInline:
  
!     perl -MWin32::GUI::BitmapInline -e inline('image.bmp') >>script.pl
  
  To use a BitmapInline (in script.pl):
  
!     use Win32::GUI;
      use Win32::GUI::BitmapInline ();
      
!     $Bitmap1 = new Win32::GUI::BitmapInline( q(
      Qk32AAAAAAAAAHYAAAAoAAAAEAAAABAAAAABAAQAAAAAAIAAAAAAAAAAAAAAABAAAAAQAAAAAAAA
      AACcnABjzs4A9/f3AJzO/wCc//8Azv//AP///wD///8A////AP///wD///8A////AP///wD///8A
--- 181,192 ----
  To create a BitmapInline:
  
!     perl -MWin32::GUI::BitmapInline -e "inline('image.bmp')" >>script.pl
  
  To use a BitmapInline (in script.pl):
  
!     use Win32::GUI();
      use Win32::GUI::BitmapInline ();
      
!     $Bitmap1 = Win32::GUI::BitmapInline->new( q(
      Qk32AAAAAAAAAHYAAAAoAAAAEAAAABAAAAABAAQAAAAAAIAAAAAAAAAAAAAAABAAAAAQAAAAAAAA
      AACcnABjzs4A9/f3AJzO/wCc//8Azv//AP///wD///8A////AP///wD///8A////AP///wD///8A
***************
*** 102,113 ****
  
  This module can be used to "inline" a bitmap file in your script, so
! that it doesn't need to be accompained by several external files 
  (less hassle when you need to redistribute your script or move it 
  to another location).
  
  The C<inline> function is used to create an inlined bitmap resource; it
! will print on STDOUT the packed data including the lines of Perl  
! needed to use the inlined bitmap resource; it is intended to be used as 
! a one-liner whose output is appended to your script.
  
  The function takes the name of the bitmap file to inline as its first
--- 199,215 ----
  
  This module can be used to "inline" a bitmap file in your script, so
! that the script doesn't need to be accompained by several external files 
  (less hassle when you need to redistribute your script or move it 
  to another location).
  
+ =head2 FUNCTIONS
+ 
+ =head3 inline
+ 
  The C<inline> function is used to create an inlined bitmap resource; it
! will print on the currently selected filehandle (STDOUT by default) the
! packed data including the lines of Perl needed to use the inlined bitmap
! resource; it is intended to be used as a one-liner whose output is
! appended to your script.
  
  The function takes the name of the bitmap file to inline as its first
***************
*** 115,119 ****
  the name of the bitmap object in the resulting scriptlet, eg:
  
!     perl -MWin32::GUI::BitmapInline -e inline('image.bmp','IMAGE')
      
      $IMAGE = new Win32::GUI::BitmapInline( q( ...
--- 217,221 ----
  the name of the bitmap object in the resulting scriptlet, eg:
  
!     perl -MWin32::GUI::BitmapInline -e "inline('image.bmp','IMAGE')"
      
      $IMAGE = new Win32::GUI::BitmapInline( q( ...
***************
*** 122,196 ****
  (the next ones $Bitmap2 , $Bitmap3 and so on).
  
! Note that the object returned by C<new Win32::GUI::BitmapInline> is
! a regular Win32::GUI::Bitmap object.
  
! With version 0.02 you can inline icons and cursors too. Nothing changes
! in the inlining process, just the file extension:
  
!     perl -MWin32::GUI::BitmapInline -e inline('harrow.cur','Cursor1') >>script.pl
!     perl -MWin32::GUI::BitmapInline -e inline('guiperl.ico','Icon1') >>script.pl
  
  The module recognizes from the extension the type of object that it
  should recreate, so it will add these lines to F<script.pl>:
  
!     $Cursor1 = newCursor Win32::GUI::BitmapInline( q( ...
!     $Icon1 = newIcon Win32::GUI::BitmapInline( q( ...
     
! C<newCursor> or C<newIcon> are used in place of just C<new>. As above,
! the returned objects are regular Win32::GUI objects (respectively,
! Win32::GUI::Cursor and Win32::GUI::Icon).
  
! =head1 WARNINGS
  
! =over 4
  
! =item * 
  
! B<Requires MIME::Base64>
  
! ...and, of course, Win32::GUI :-)
  
! =for html <P>
  
! =item * 
  
! B<Don't use it on large bitmap files!>
  
! BitmapInline was designed for small bitmaps, such as
! toolbar items, icons, et alia; it is not at all 
! performant.
! Inlined data takes approximatively the size of your
! bitmap file plus a 30%; thus, if you inline a 100k bitmap 
! you're adding about 130k of bad-looking data to your script...
  
! =for html <P>
  
! =item * 
  
! B<Your script must have write access to its current directory>
  
! When inlined data are used in your script (with 
! C<new Win32::GUI::BitmapInline...>)
! a temporary file is created, then loaded as a regular
! bitmap and then immediately deleted.
! This will fail if your script is not able to create and delete
! files in the current directory at the moment of the call.
! One workaround could be to change directory to a safer place
! before constructing the bitmap:
  
!     chdir("c:\\temp");
!     $Bitmap1 = new Win32::GUI::BitmapInline( ... );
  
! A better solution could pop up in some future release...
  
! =for html <P>
  
! =item *
  
! B<The package exports C<inline> by default>
  
  For practical reasons (see one-liners above), C<inline> is 
! exported by default into your C<main> namespace; to avoid
! this side-effect is recommended to use the module in your
  production scripts as follows:
  
--- 224,313 ----
  (the next ones $Bitmap2 , $Bitmap3 and so on).
  
! Note that the object returned by C<< Win32::GUI::BitmapInline->new( ... ) >> is
! a regular L<Win32::GUI::Bitmap|Win32::GUI::Bitmap> object.
  
! With version 0.02 and later you can inline icons and cursors too. Nothing
! changes in the inlining process, just the file extension:
  
!     perl -MWin32::GUI::BitmapInline -e "inline('harrow.cur')"  >>script.pl
!     perl -MWin32::GUI::BitmapInline -e "inline('guiperl.ico')" >>script.pl
  
  The module recognizes from the extension the type of object that it
  should recreate, so it will add these lines to F<script.pl>:
  
!     $Cursor1 = Win32::GUI::BitmapInline->newCursor( q( ...
!     $Icon2 = Win32::GUI::BitmapInline->newIcon( q( ...
     
! =head3 new
  
!   my $bitmap = Win32::GUI::BitmapInline->new($data);
  
! Returns a regular L<Win32::GUI::Bitmap|Win32::GUI::Bitmap> object from
! the data created by the inlining process.
  
! =head3 newCursor
  
! Similar in behaviour to C<new()>, except it returns a
! Win32::GUI::Cursor object.
  
! =head3 newIcon
  
! Similar in behaviour to C<new()>, except it returns a
! Win32::GUI::Icon object.
  
! =head1 REQUIRES
  
! =over
  
! =item L<Win32::GUI|Win32::GUI>
  
! =item L<MIME::Base64|Mime::Base64>
  
! =item L<File::Spec|File::Spec>
  
! =item L<threads::shared|threads::shared>
  
! =back
  
! =head1 WARNINGS
  
! =over
  
! =item * Don't use it on large bitmap files!
  
! BitmapInline was designed for small bitmaps, such as toolbar items,
! icons, et alia; it is not at all performant. Inlined data takes
! approximatively the size of your bitmap file plus a 30% overhead;
! thus, if you inline a 100k bitmap you're adding about 130k of
! bad-looking data to your script...
  
! =item * File::Spec must be able to find a writable temporary directory.
! 
! When inlined data is used in your script (with
! C<Win32::GUI::BitmapInline->new( ... )>),
! then a temporary file is created, loaded as a regular bitmap and then
! immediately deleted. This will fail if Win32::GUI::BitmapInline script
! is not able to create and delete files in a suitable temporary
! directory at the moment of the call.
! 
! Win32::GUI::BitmapInline uses L<File::Spec->tmpdir()|File::Spec/tmpdir>
! to locate a suitable temporary directory.  This should be fine under most
! circumstances, but if you find it returning the current directory (which means
! that File::Spec was not able to find a writable temporary elesewhere), and you
! are not confident that the current directory will always be writable, then 
! one workaround is to change directory to a known safe place before constructing
! the bitmap, and changing back afterwards:
! 
!     my $olddir = cwd();
!     my $tmpdir = get_some_writable_dir();
!     chdir($tmpdir);
!     $Bitmap1 = Win32::GUI::BitmapInline->new( ... );
!     chdir($olddir);
! 
! =item * The package exports the C<inline> function by default.
  
  For practical reasons (see one-liners above), C<inline> is 
! exported by default into the caller's namespace; to avoid
! this side-effect is strongly recommended to use the module in your
  production scripts as follows:
  
***************
*** 201,209 ****
  =head1 VERSION
  
! Win32::GUI::BitmapInline version 0.02, 24 January 2001.
  
  =head1 AUTHOR
  
  Aldo Calpini ( C<da...@pe...> ).
  
  =cut
--- 318,327 ----
  =head1 VERSION
  
! Win32::GUI::BitmapInline version 0.03, 24 January 2001.
  
  =head1 AUTHOR
  
  Aldo Calpini ( C<da...@pe...> ).
+ Modifications by Robert May ( C<rob...@us...> ).
  
  =cut