1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
use strict; use warnings; use Image::Magick; use DBI; use MIME::Base64; use Tk::JPEG; use Tk::PNG; my $dsn = "DBI:mysql:database=Fotos;host=127.0.0.1;port=3306"; my $dbh = DBI::->connect( $dsn, 'root', 'root', { RaiseError => 1, PrintError => 0, AutoCommit => 1 } ); my $sql = "SELECT * FROM kartenvorlagen WHERE idkartenvorlagen = '23' LIMIT 1;"; my $sth = $dbh->prepare($sql); $sth->execute; my $ref = $sth->fetchrow_hashref; if ( $sth->rows == 1 ) { my $image = Image::Magick->new; my $blob = $$ref{'Grafik'}; $blob = encode_base64($blob); # Habe es mit und ohne versucht.. $image->BlobToImage($blob); $image->Write('test.jpg'); }
1 2 3 4 5 6 7 8 9 10 11 12 13 14
#!/usr/bin/perl use strict; use warnings; use Image::Magick; use MIME::Base64; my $infile='in.jpg.base64'; my $blob=eval{local($/,@ARGV)=(undef,$infile); <>}; $blob = decode_base64($blob); my $image = Image::Magick->new(); $image->BlobToImage($blob); $image->Display();
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
#!/usr/bin/perl use 5.008; use strict; use warnings; use Image::Magick; use MIME::Base64; use DBI; #data:image/gif;base64,R0lGODlhJAAlAPcAAAAAAAAAMwAAZgAAmQAAzAAA/wArAAArMwArZgArmQArzAAr/wBVAABVMwBVZgBVmQBVzABV/wCAAACAMwCAZgCAmQCAzACA/wCqAACqMwCqZgCqmQCqzACq/wDVAADVMwDVZgDVmQDVzADV/wD/AAD/MwD/ZgD/mQD/zAD//zMAADMAMzMAZjMAmTMAzDMA/zMrADMrMzMrZjMrmTMrzDMr/zNVADNVMzNVZjNVmTNVzDNV/zOAADOAMzOAZjOAmTOAzDOA/zOqADOqMzOqZjOqmTOqzDOq/zPVADPVMzPVZjPVmTPVzDPV/zP/ADP/MzP/ZjP/mTP/zDP//2YAAGYAM2YAZmYAmWYAzGYA/2YrAGYrM2YrZmYrmWYrzGYr/2ZVAGZVM2ZVZmZVmWZVzGZV/2aAAGaAM2aAZmaAmWaAzGaA/2aqAGaqM2aqZmaqmWaqzGaq/2bVAGbVM2bVZmbVmWbVzGbV/2b/AGb/M2b/Zmb/mWb/zGb//5kAAJkAM5kAZpkAmZkAzJkA/5krAJkrM5krZpkrmZkrzJkr/5lVAJlVM5lVZplVmZlVzJlV/5mAAJmAM5mAZpmAmZmAzJmA/5mqAJmqM5mqZpmqmZmqzJmq/5nVAJnVM5nVZpnVmZnVzJnV/5n/AJn/M5n/Zpn/mZn/zJn//8wAAMwAM8wAZswAmcwAzMwA/8wrAMwrM8wrZswrmcwrzMwr/8xVAMxVM8xVZsxVmcxVzMxV/8yAAMyAM8yAZsyAmcyAzMyA/8yqAMyqM8yqZsyqmcyqzMyq/8zVAMzVM8zVZszVmczVzMzV/8z/AMz/M8z/Zsz/mcz/zMz///8AAP8AM/8AZv8Amf8AzP8A//8rAP8rM/8rZv8rmf8rzP8r//9VAP9VM/9VZv9Vmf9VzP9V//+AAP+AM/+AZv+Amf+AzP+A//+qAP+qM/+qZv+qmf+qzP+q///VAP/VM//VZv/Vmf/VzP/V////AP//M///Zv//mf//zP///wAAAAAAAAAAAAAAACH5BAEAAPwALAAAAAAkACUAAAj/APcJHEiwoMGDCBMqXMiwocOHA8+BMwcOXDuIDM9leyXtVTZU5zAq/JYqG7aS016ZE4kwW8mTJl9hm3aRJUGX2Fx+zJZyWi13NgWmyvnq3LdpJodyDGkzm8tvAod1RDo0Gy+br6a5yjawXdat2LIyxQgu57SC4DZOGzrtKsZzU90OpFdrGlFsYx22K7k1r8BzHLOm+lZTb1ikB9ullJbU70JwShGe26oT70N3qHg6Fqj45GG5DL9txNZLsiuqOS023Ptx2sqD7tJu1ZoKXMO0mbMVNthrKuXNBRVTtqXQK+PWoBGybrsQrsfcr4t3jJ6QLs9sp22Bs7W7IGDqCs8pOEVqFjxBd92Lmz39KjPxoATFy9zIuBb84IzZerxfkJjFjU7xhxA4+wmYmG0GJqjgggw26OCDCgYEADs= my $ref = { Grafik => 'R0lGODlhJAAlAPcAAAAAAAAAMwAAZgAAmQAAzAAA/wArAAArMwArZgArmQArzAAr/wBVAABVMwBVZgBVmQBVzABV/wCAAACAMwCAZgCAmQCAzACA/wCqAACqMwCqZgCqmQCqzACq/wDVAADVMwDVZgDVmQDVzADV/wD/AAD/MwD/ZgD/mQD/zAD//zMAADMAMzMAZjMAmTMAzDMA/zMrADMrMzMrZjMrmTMrzDMr/zNVADNVMzNVZjNVmTNVzDNV/zOAADOAMzOAZjOAmTOAzDOA/zOqADOqMzOqZjOqmTOqzDOq/zPVADPVMzPVZjPVmTPVzDPV/zP/ADP/MzP/ZjP/mTP/zDP//2YAAGYAM2YAZmYAmWYAzGYA/2YrAGYrM2YrZmYrmWYrzGYr/2ZVAGZVM2ZVZmZVmWZVzGZV/2aAAGaAM2aAZmaAmWaAzGaA/2aqAGaqM2aqZmaqmWaqzGaq/2bVAGbVM2bVZmbVmWbVzGbV/2b/AGb/M2b/Zmb/mWb/zGb//5kAAJkAM5kAZpkAmZkAzJkA/5krAJkrM5krZpkrmZkrzJkr/5lVAJlVM5lVZplVmZlVzJlV/5mAAJmAM5mAZpmAmZmAzJmA/5mqAJmqM5mqZpmqmZmqzJmq/5nVAJnVM5nVZpnVmZnVzJnV/5n/AJn/M5n/Zpn/mZn/zJn//8wAAMwAM8wAZswAmcwAzMwA/8wrAMwrM8wrZswrmcwrzMwr/8xVAMxVM8xVZsxVmcxVzMxV/8yAAMyAM8yAZsyAmcyAzMyA/8yqAMyqM8yqZsyqmcyqzMyq/8zVAMzVM8zVZszVmczVzMzV/8z/AMz/M8z/Zsz/mcz/zMz///8AAP8AM/8AZv8Amf8AzP8A//8rAP8rM/8rZv8rmf8rzP8r//9VAP9VM/9VZv9Vmf9VzP9V//+AAP+AM/+AZv+Amf+AzP+A//+qAP+qM/+qZv+qmf+qzP+q///VAP/VM//VZv/Vmf/VzP/V////AP//M///Zv//mf//zP///wAAAAAAAAAAAAAAACH5BAEAAPwALAAAAAAkACUAAAj/APcJHEiwoMGDCBMqXMiwocOHA8+BMwcOXDuIDM9leyXtVTZU5zAq/JYqG7aS016ZE4kwW8mTJl9hm3aRJUGX2Fx+zJZyWi13NgWmyvnq3LdpJodyDGkzm8tvAod1RDo0Gy+br6a5yjawXdat2LIyxQgu57SC4DZOGzrtKsZzU90OpFdrGlFsYx22K7k1r8BzHLOm+lZTb1ikB9ullJbU70JwShGe26oT70N3qHg6Fqj45GG5DL9txNZLsiuqOS023Ptx2sqD7tJu1ZoKXMO0mbMVNthrKuXNBRVTtqXQK+PWoBGybrsQrsfcr4t3jJ6QLs9sp22Bs7W7IGDqCs8pOEVqFjxBd92Lmz39KjPxoATFy9zIuBb84IzZerxfkJjFjU7xhxA4+wmYmG0GJqjgggw26OCDCgYEADs=' }; my $blob = $ref->{'Grafik'}; # Fülle BLOB mit binären Daten $blob = MIME::Base64::decode_base64($blob); my $dbh = DBI->connect("dbi:mysql:test", "test", "test") or die $DBI::errstr; # Tabelle erzeugen und BLOB mit binären Daten beschicken $dbh->do('DROP TABLE test'); $dbh->do('CREATE TABLE test (id INT, b BLOB)'); $dbh->do('INSERT INTO test VALUES(1, ?)', undef, $blob); # Daten holen my $hash_ref = $dbh->selectrow_hashref('SELECT * FROM test WHERE id = 1'); if ($hash_ref) { $blob = $hash_ref->{'b'} or die "BLOB leer!?"; ### testmode zur Ausgabe auf Webserver #binmode (STDOUT); #print 'Content-Type: image/gif', "\n\n", $blob; my $image = Image::Magick->new(); $image->BlobToImage($blob); $image->Write('/tmp/test.png'); }
2013-01-11T18:46:31 KeanWas für eine Ausgabe machtest du nach jeder Zeile?Alle Beispiele (natürlich angepasst) bringen weder eine Datei noch eine Fehlermeldung.
Ich habe mal nach jeder Zeile eine Ausgabe gemacht und dabei ist mir aufgefallen, dass er nach dem BlobToImage nichts mehr ausgibt.
QuoteIch habe Windows 7 (64bit), Strawberry-Perl 5.10.1.5 (32bit), Image::Magick mit ppm (Image-Magick [6.7.1] ImageMagick PERL Extension (QD=16)) installiert. Läuft alles.Ich teste das ganze unter Windows 7 32bit, mit einem AS Perl 5.10.1 und Image-Magick 6.7.1 QD=16.
2013-01-11T18:46:31 KeanWas bedeutet das 'nichts mehr ausgibt'? Funktioniert das Write nicht mehr oder dein print auf die Konsole ausgabe?(...)dabei ist mir aufgefallen, dass er nach dem BlobToImage nichts mehr ausgibt.
1
2
3
4
5
6
7
8
9
10
11
12
13
cpan> m MIME::Base64
Fetching with LWP:
http://cpan.strawberryperl.com/authors/id/G/GA/GAAS/CHECKSUMS
Module id = MIME::Base64
DESCRIPTION Encode/decode Base 64 (RFC 2045)
CPAN_USERID GAAS (Gisle Aas <gisle@ActiveState.com>)
CPAN_VERSION 3.13
CPAN_FILE G/GA/GAAS/MIME-Base64-3.13.tar.gz
UPLOAD_DATE 2010-11-26
DSLIP_STATUS Rdhf? (released,developer,hybrid,functions,)
MANPAGE MIME::Base64 - Encoding and decoding of base64 strings
INST_FILE C:\strawberry\perl\lib\MIME\Base64.pm
INST_VERSION 3.13