All pastes #107910 Raw Edit

Someone

public text v1 · immutable
#107910 ·published 2006-07-31 04:47 UTC
rendered paste body
#! /usr/bin/perl
    use strict;
    use Getopt::Std;
    use Compress::Zlib;
    use constant COMPRESSION_METHOD => 0 ;
    
    # Declare variables
    my (
        $ihdr,              # IHDR chunk
        $infile,            # input filename
        $png,               # png data that doesn't concern us (just copy)
        $pngsize,           # Total size of png
        $pos,               # position in $png
        $sig,               # PNG signature
        $status,            # Status of Compress::Zlib
        $tchunk,            # content of text chunk
        $text,              # 'string' of all tEXt chunks with CRC, etc.
        $zhandle,           # Compression handle
        $zzTXt,             # Compressed chunk
        %opts,              # Command line options
        %tEXt,              # tEXt chunks to insert
        %zTXt,              # zTXt chunks to insert
    );

#-----------------------------------------------------------------------------
#-----------------------------------------------------------------------------
    getopt('zt',\%opts);

    $tEXt{'Copyright'} = $opts{'z'} ;
    $tEXt{'Source'} = 'http://www.ani-mayhem.com/' ;
    $tEXt{'Author'} = 'Ani-Mayhem Online' ;
    $tEXt{'Title'} = $opts{'t'} ;

    #-------------------------------------------------------------------------
    # Read the input file
    #-------------------------------------------------------------------------

    $infile = $ARGV[0] ;
    $text = '' ;

    $pngsize = -s $infile;

    open(IN, "$infile") or die;
    binmode(IN);
    read(IN, $sig, 8);
    read(IN, $ihdr, 25 ) ;

    read(IN, $png, $pngsize-8-25);
    close(IN);

    $pos=0;

    1 while (&ChunkPrint);

    #-------------------------------------------------------------------------
    # Process the command line options
    #-------------------------------------------------------------------------
    foreach my $boob ( keys %tEXt )
    {
        my $tbuffer;
        if ( substr($tEXt{$boob},0,1) eq '@' )    # @ indicates get text from a file
        {
            open(IN, "<".substr($tEXt{$boob},1) ) or die;
            $tbuffer = join '', <IN> ;
            close(IN) ;
        }
        else
        {
            $tbuffer = $tEXt{$boob} ;
            $tbuffer =~ s/\\([tnrfbae])/control_char($1)/eg;
        }
        $tchunk = sprintf "%s%c%s", $boob, 0, $tbuffer ;
        $text .= pack "N A* N", (length( $tchunk ), 'tEXt'.$tchunk, &crc32( 'tEXt'.$tchunk ) ) ;
        $pngsize += length($tchunk) + 8 ;
    }


    #-------------------------------------------------------------------------
    # Join the bits together, and dump them in binary mode to output
    #-------------------------------------------------------------------------
    $png = $sig.$ihdr.$text.$png;

    binmode(STDOUT);
    print  $png ;

    print STDERR "PNG file (size $pngsize) written to STDOUT\n" ;

#-----------------------------------------------------------------------------
# Subroutines
#-----------------------------------------------------------------------------

# ChunkPrint
sub ChunkPrint
{

    my $chunk=substr($png, $pos, 8);
    my ($length, $type)=unpack("N A4", $chunk);

    if ($type eq 'IEND' || $pos > ($pngsize-12))
    {
        return 0;
    }

    $pos +=$length+12;
}

# control_char
sub control_char
{
    $_ = $_[0] ;
    $_ =~ tr/tnrfbae/\t\n\r\f\b\a\e/ ;
    return $_ ;
}

#-----------------------------------------------------------------------------
# END OF FILE - png-tEXt.pl
#-----------------------------------------------------------------------------