<!-- TODO: this API is a bit weird. really the blob_element should be
     the top level element to save a lot of ->image calls -->
<DocumentDefinition>
  <name>Comma_Standard_Image</name>
    
  <blob_element>
    <name>image</name>
    <extension><![CDATA[ $self->image_extension() ]]></extension>
 
    <method>
      <name>image_checksum</name>
      <code><![CDATA[ sub { $_[0]->_data_hash()->{checksum} }]]></code>
    </method>

    <method>
      <name>image_dimensions</name>
      <code><![CDATA[ sub {
        my $dh = $_[0]->_data_hash();
        return $dh->{width}."x".$dh->{height};
      }]]></code>
    </method>

    <method>
      <name>image_width</name>
      <code><![CDATA[ sub { $_[0]->_data_hash()->{width} }]]></code>
    </method>

    <method>
      <name>image_height</name>
      <code><![CDATA[ sub { $_[0]->_data_hash()->{height} }]]></code>
    </method>

    <method>
      <name>image_content_type</name>
      <code><![CDATA[ sub { $_[0]->_data_hash()->{content_type} }]]></code>
    </method>

    <method>
      <name>image_extension</name>
      <code><![CDATA[ sub {
        my $ext = $_[0]->_data_hash()->{extension};
        if(!defined($ext)) {
          #NOTE: this is just an artifact of <extension> use above,
          #nothing to worry about, probably shouldn't even log it...
          XML::Comma::Log->warn("called image_extension too soon - before any set/set_from_file/read");
          return undef;
        }
        return $ext;
      } ]]></code>
    </method>

    <!-- this method is seperate from get_thumb so that you can know
         the width and height attributes for an <img> tag -->
    <method>
      <name>get_thumb_dims</name>
      <code>
        <![CDATA[
          #usage:
          #	$self->get_thumb_dims(scale => 0.5);
          #	$self->get_thumb_dims(width => 150);
          #	$self->get_thumb_dims(height => 200);
          #sets width == 200 if width > height, else height = 200
          #and proportionally scales the other dimension
          #	$self->get_thumb_dims(max_dim => 200);
          #or if you don't care about scaling proportionally:
          #	$self->get_thumb_dims(width => 100, height => 200);
          sub {
            my ($self, %args) = @_;
            my $img = $self->_data_hash()->{image};
            my ($new_w, $new_h);
            if($args{scale}) {
              $new_w = $img->getwidth  * $args{scale};
              $new_h = $img->getheight * $args{scale};
            } elsif($args{max_dim}) {
              die "illegal arguments" if($args{width} || $args{height});
              if($img->getwidth > $img->getheight) {
                $new_w = $args{max_dim};
                $new_h = ($new_w / $img->getwidth) * $img->getheight;
              } else {
                $new_h = $args{max_dim};
                $new_w = ($new_h / $img->getheight) * $img->getwidth;
              }
            } elsif($args{width}) {
              if($args{height}) {
                $new_w = $args{width};
                $new_h = $args{height};
              } else {
                $new_w = $args{width};
                $new_h = ($new_w / $img->getwidth) * $img->getheight;
              }
            } elsif($args{height}) {
              $new_h = $args{height};
              $new_w = ($new_h / $img->getheight) * $img->getwidth;
            } else {
              die "get_thumb got unrecognized args: ".join(" ", keys %args);
            }
            # round to ints
            $new_w = int(0.5+$new_w);
            $new_h = int(0.5+$new_h);
            return ($new_w, $new_h);
          }]]>
      </code>
    </method>

    <method>
      <name>get_thumb</name>
      <code>
        <![CDATA[
          #usage:
          #	$self->get_thumb(scale => 0.5);
          #	$self->get_thumb(width => 150);
          #	$self->get_thumb(height => 200);
          #sets width == 200 if width > height, else height = 200
          #and proportionally scales the other dimension
          #	$self->get_thumb(max_dim => 200);
          #or if you don't care about scaling proportionally:
          #	$self->get_thumb(width => 100, height => 200);
          #to fine tune jpeg compression:
          #	$self->get_thumb(high_quality => [0,1]);
          #	$self->get_thumb(jpeg_quality => 0..100);
          #note jpeg_quality parameter overrides the "high quality" parameter
          #which is just there to distinguish say a small thumbnail from
          #a 600x400 -> 520x347 resize to fit in a page
          sub {
            my ($self, %args) = @_;
            my $img = $self->_data_hash()->{image};
            my ($new_w, $new_h) = $self->get_thumb_dims(%args);
            #preserve transparency if it's there by using png
            #1 channel = bw, 2 channels = bw+alpha, 3 channels = rgb,
            #4 channels = rgba. use png if need transparency. else jpeg
            #this is important because (*,*,*,1) are all equal, and
            #different paint programs deal with fully transparent values
            #in different ways, so you can get "a picture from nothing"
            #in the places that were alpha instead of just white or black
            my $thumb_format = $args{format} ||
                    (($img->getchannels % 2) ? "jpeg" : "png");
            my $jpeg_quality = 75; #libjpeg default
            if($thumb_format eq "jpeg") {
               $jpeg_quality = $args{high_quality} ? 88 : 75;
               $jpeg_quality = $args{jpeg_quality} || $jpeg_quality;
            }

            #if you ask for a thumbnail that winds up being the same
            #size and format as the original, just return that -- this
            #avoids generation loss
            #TODO: what if orig_jpeg_q == 100 and we want thumb_jpeg_q == 20?
            #(note transitions the other way make no sense - we can't get
            #quality back from a bad original) ... really we need a way to
            #determine jpeg quality of an image and squirrel that in data_hash,
            #then if the desired and actual are "close enough", return unmodified
            my $cur_ext = (map { s/^\.//; s/jpg/jpeg/; $_ } $self->image_extension);
            my ($blob, %sargs);
            if( ($self->image_dimensions eq "${new_w}x${new_h}") &&
                ($thumb_format eq $cur_ext)) {
              $blob = $self->_data_hash()->{blob};
              $sargs{image} = $img;
              $sargs{checksum} = $_[0]->_data_hash()->{checksum};
            } else {

              my $thumb = Imager->new();
              #TODO: should the cache be somewhere more permanent?
              my $tmpdir = XML::Comma::Configuration->get("tmp_directory").
                "/comma_standard_image_cache";
              my $hash = $self->_data_hash()->{checksum};
              my $cache_fn = "${tmpdir}/${hash}-${new_w}x${new_h}.${thumb_format}";

              $thumb->read(file => $cache_fn) if ( -e "$cache_fn" );

              #regenerate if there is no cache img or we could't load it
              my $did_regenerate;
              if (!$thumb->getwidth) {
                #"mixing" previews are best when scaling down, which is
                #what we almost always do
                $thumb = $img->scale(xpixels=>$new_w, ypixels=>$new_h,
                                     type => 'nonprop', qtype => 'mixing');
                $did_regenerate = 1;
              }

              #generate the actual thumbnail image
              #TODO: there are cases where a png/gif will be smaller
              #*and* more accurate - try to detect those?
              my $write_args = { data => \$blob, type => $thumb_format };
              $write_args->{jpegquality} = $jpeg_quality if($thumb_format eq "jpeg");
              $thumb->write(%$write_args) or die $thumb->errstr;

              # caching: set the image
              if($did_regenerate) {
                my $old_umask = umask(0000);
                mkdir("$tmpdir", 0777);
                my $tmpfile = "$cache_fn.$$.".int(0.5+rand 9999);
                open(my $fh, ">$tmpfile") || XML::Comma::Log->warn("can't cache thumbnail, open: $!");
                print $fh $blob || XML::Comma::Log->warn("can't cache thumbnail, print: $!");
                close($fh);
                rename($tmpfile, $cache_fn) || XML::Comma::Log->warn("can't rename cached thumbnail into place: $!");
                umask($old_umask);
              }

              #we already have the internal representation, don't re-parse
              #the jpeg/png/what have you
              $sargs{image} = $thumb;

            }
            $sargs{format} = $thumb_format;

            my $thumb_img = XML::Comma::Doc->new(type => "Comma_Standard_Image");
            # NOTE: this is a much more efficient version of
            # $thumb_img->image->set($blob) for when we already know
            # things that are expensive to compute, like the internal
            # imager representation or the checksum
            $thumb_img->element("image")->set($blob, no_set_hooks => 1);
            $thumb_img->image->_fill_pnotes_data(\$blob, %sargs);
            return $thumb_img;
          }]]>
      </code>
    </method>

    <method>
       <name>_data_hash</name>
       <code><![CDATA[ sub { $_[0]->{_local_hash} ||= {}; } ]]></code>
    </method>

    <method>
      <name>_fill_pnotes_data</name>
      <code>
        <![CDATA[
          sub {
            my ( $self, $blob, %args ) = @_;
            # TODO: this can probably be simplified since Imager->open() 
            # supports file, fd, fh, data args...
            # $blob is either a reference to data or a filename
            # an empty $blob/ref means that this is an
            # "erase", not a "set".
            my $fn;
            if ( (ref($blob) eq "SCALAR") && defined($$blob)) {
              #ref to scalar data
              $fn = "(in-memory scalar)";
              $blob = $$blob;
            } elsif (ref($blob) eq "GLOB") {
              #filehandle
              $fn = "(pre-existing filehandle)";
              local $/;
              $blob = <$blob>;
            } elsif ( !ref($blob) and defined $blob ) {							
              $fn = $blob;
              open ( my $fh, "<$fn" ) || die "couldn't open image: '$fn'";
              local $/;
              $blob = <$fh>;
              close ( $fh );
            } else {
              # erase: clear the pnotes field
              $self->_data_hash()->{image}        = undef;
              $self->_data_hash()->{file}         = undef;
              $self->_data_hash()->{blob}         = undef;
              $self->_data_hash()->{width}        = undef;
              $self->_data_hash()->{height}       = undef;
              $self->_data_hash()->{content_type} = undef;
              $self->_data_hash()->{extension}    = undef;
              $self->_data_hash()->{checksum}     = undef;
              return;
            }
            my $img;
            if(ref($args{image})) {
              $img = $args{image}->copy();
            } else {
              $img = Imager->new();
              $img->open(data => $blob) or die $img->errstr;
            }
            $self->_data_hash()->{image}        = $img;
            $self->_data_hash()->{file}         = $fn;
            $self->_data_hash()->{blob}         = $blob;
            $self->_data_hash()->{width}        = $img->getwidth;
            $self->_data_hash()->{height}       = $img->getheight;
            my $fmt;
            if(defined($args{format})) {
              $fmt = ".".$args{format};
            } else {
              $fmt = $img->tags(name => "i_format");
              $fmt = ".$fmt";
            }
            $fmt =~ s/jpeg$/jpg/;
            $self->_data_hash()->{extension}    = $fmt;
            $self->_data_hash()->{content_type} =
              $self->def_pnotes->{image_content_type_sub}->($fmt);
            my $md5_val;
            if(defined($args{checksum})) {
              $md5_val = $args{checksum};
            } else {
              my $md5;
              $md5 = Digest::MD5->new();
              $md5->add ( $blob );
              $md5_val = $md5->hexdigest();
            }
            $self->_data_hash()->{checksum} = $md5_val;
          }]]>
      </code>
    </method>
      
    <set_hook>
      <![CDATA[ sub { $_[0]->_fill_pnotes_data($_[1]) } ]]>
    </set_hook>
    <set_from_file_hook>
      <![CDATA[ sub { $_[0]->_fill_pnotes_data($_[1]) } ]]>
    </set_from_file_hook>
    <read_hook>
      <![CDATA[ sub { $_[0]->_fill_pnotes_data($_[0]->get_location()); } ]]>
    </read_hook>

    <def_hook>
      <![CDATA[
        use XML::Comma::Util;
        use Digest::MD5;
        use Imager;
        $self->def_pnotes->{image_content_type_sub} = sub {
          my ($ext) = @_;
          $ext    = lc($ext);
          return 'image/gif'  if($ext eq '.gif');
          return 'image/jpeg' if($ext =~ /^\.jp(e|g|eg)$/);
          return 'image/png'  if($ext eq '.png');
          return 'image/bmp'  if($ext eq '.bmp');
          die "unknown image content type for ext: $ext";
        };
      ]]>
    </def_hook>
          
  </blob_element>

  <def_hook>
    <![CDATA[
      #HACK - blob_element should be root element!
      $self->def_pnotes->{image_content_type_sub} = 
        $self->def_by_name("image")->def_pnotes->{image_content_type_sub};
    ]]>
  </def_hook>

  <!-- utility methods which can be called statically (sans-doc) from
      XML::Comma::Def->Comma_Standard_Image() -->

  <method>
    <name>image_extension</name>
    <code>
      <![CDATA[
        #TODO: there must be a way to get this info from 
        #Imager::image.c::i_test_format_probe::formats[]
        #for now, use this code, adapted from GD::Image::_image_type
        sub {
          XML::Comma::Log->warn("top level image_extension call from CSI.def discouraged, may be inaccurate!");
          my ($self, $data) = @_;
          return '.png' if $data =~ /^\x89PNG/;
          return '.gif' if $data =~ /^GIF8/;
          return '.bmp' if $data =~ /^BM/;
          return '.jpg' if $data =~ /^\xff\xd8\xff[\xd0-\xff]/;

#					return '.gd2' if $data =~ /gd2\x00/;
#					return '.xpm' if substr($data,0,9) eq "/* XPM */";
          die "format not supported / not an image, first 10 bytes: ".
            join("", map { sprintf("%x", ord($_))." " }
               split(//, substr($data,0,10))); 
        }
      ]]>
    </code>
  </method>

  <method>
    <name>image_content_type</name>
    <code><![CDATA[ sub {
        $_[0]->def_pnotes->{image_content_type_sub}->(@_[1..$#_]);
##wtf!
#        shift()->def_pnotes->{image_content_type_sub}->(@_);
    } ]]></code>
  </method>

</DocumentDefinition>

