view release on metacpan or  search on metacpan

Png.pm  view on Meta::CPAN

    my $datum = (($red & 0x7) << 5) | (($green & 0x3) << 3) | ($blue & 0x7);
    $data .= chr $datum;
  }
  $data;
}

sub make_image {
  my $self = shift;
  # We get a copy to play with
  my $raw = $self->raw;
  my $offset = length ($raw)/3;
  my $img = new Imager;

  while ($offset--) {
    my $datum = unpack "x$offset C", $_[0];
    my $rgb = substr ($raw, $offset * 3, 3);
    # Pack 8 bits into the low bits of R G and B
    $rgb &= "\xF8\xFC\xF8";
    $rgb |= ("\x07\x03\x07" & pack 'C3', $datum >> 5, $datum >> 3, $datum);
    substr($raw, $offset * 3, 3, $rgb);
  }
  $img->read(data=>$raw, type => 'raw', xsize => $self->x,
	     ysize => $self->y, datachannels => 3,interleave => 0);
  $img;
}

sub calculate_datum_length {
  my $self = shift;
  $self->x * $self->y;
}

package Acme::Steganography::Image::Png::RGB;

use vars '@ISA';
@ISA = 'Acme::Steganography::Image::Png';

# Raw data in the low bits of a colour image

sub write_images {
  my $self = shift;
  my $victim = shift;

  my $img;
  if (ref($victim) && $victim->isa('Imager')) {
    $img = $victim;
  } else {
    $img = new Imager;
    $img->open(file=>$victim, type=>'jpeg') or croak($img->errstr);
  }


  $self->x($img->getwidth());
  $self->y($img->getheight());

  my $raw;
  $img->write(data=> \$raw, type => 'raw')
    or croak($img->errstr);

  $self->raw($raw);

  $self->SUPER::write_images;
}
package Acme::Steganography::Image::Png;

sub generate_next_image {
    my ($self) = shift;
    my $datum = $self->generate_header;
    my $offset = $self->offset;
    my $datum_length = $self->datum_length;
    # Fill our blob of data to the correct length
    my $grab = $datum_length - length $datum;
    $datum .= substr ${$self->data()}, $offset, $grab;
    $self->offset($offset + $grab);

    if (length $datum < $datum_length) {
      # Need to pad it. NUL is so uninspiring.
      $datum .= "N" x ($datum_length - length $datum);
      $self->done(1);
    } elsif (length ${$self->data()} == $self->offset) {
      warn length $datum;
    }
    $self->section($self->section + 1);

    $self->make_image($datum);
}

sub new {
  my $class = shift;
  croak "Use a classname, not a reference for " . __PACKAGE__ . "::new"
    if ref $class;
  my $self = bless {}, $class;
  my %args = @_;
  my $acceptable = $self->_keys();
  foreach (keys %args) {
    croak "Unknown parameter $_" unless exists $acceptable->{$_};
    $self->set($_, $args{$_});
  }
  $self->x(352) unless $args{x};
  $self->y(288) unless $args{y};

  # Kowtow to the metadata bodging into filenames world
  $self->suffix('.png');

  $self;
}

sub type {
  'png';
}

sub write_images {
  my $self = shift;
  $self->section(0);
  $self->offset(0);
  $self->datum_length($self->calculate_datum_length());
  my $type = $self->type;
  my $filename_generator
    = $self->filename_generator || \&default_filename_generator;

  my @filenames;