This is an automatically generated mail from the syncmail system. Do not reply directly to this email. Further discussion should take place on the hackers list: [EMAIL PROTECTED]
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 <[EMAIL PROTECTED]>', ); 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 ([EMAIL PROTECTED]) { ! 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<[EMAIL PROTECTED]> ). =cut --- 318,327 ---- =head1 VERSION ! Win32::GUI::BitmapInline version 0.03, 24 January 2001. =head1 AUTHOR Aldo Calpini ( C<[EMAIL PROTECTED]> ). + Modifications by Robert May ( C<[EMAIL PROTECTED]> ). =cut ------------------------------------------------------------------------- Check out the new SourceForge.net Marketplace. It's the best place to buy or sell services for just about anything Open Source. http://ad.doubleclick.net/clk;164216239;13503038;w?http://sf.net/marketplace _______________________________________________ Perl-win32-gui-cvscommit mailing list Perl-win32-gui-cvscommit@lists.sourceforge.net https://lists.sourceforge.net/lists/listinfo/perl-win32-gui-cvscommit http://perl-win32-gui.sourceforge.net/