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
[email protected]
https://lists.sourceforge.net/lists/listinfo/perl-win32-gui-cvscommit
http://perl-win32-gui.sourceforge.net/
