The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Plack::Middleware::Watermark;

use strict;
use warnings;

our $VERSION = '0.01';

use parent qw( Plack::Middleware );
use Plack::Util::Accessor qw( comment );

use Plack::Util;
use Carp ();

sub prepare_app {
    my $self = shift;

    unless ($self->comment) {
        Carp::croak "'comment' is not defined";
    }
}

my %comment_style = (
    'html' => [ '<!--', '-->' ],
    'xml'  => [ '<!--', '-->' ],
    'css'  => [ '/*', '*/' ],
    'js'   => [ '//', '' ],
);

my %mime_type = (
    # html
    'text/html'             => 'html',
    'application/xhtml+xml' => 'html',
    # xml
    'text/xml'             => 'xml',
    'application/xml'      => 'xml',
    'application/rss+xml'  => 'xml',
    'application/atom+xml' => 'xml',
    # css
    'text/css' => 'css',
    # js
    'text/javascript'        => 'js',
    'application/javascript' => 'js',
);

sub call {
    my $self  = shift;
    my ($env) = @_;

    my $res = $self->app->($env);
    $self->response_cb($res, sub {
        my $res  = shift;
        my $type = Plack::Util::header_get($res->[1], 'Content-Type');
        if ($type && $res->[0] == 200) {
            ($type) = split /;\s*/, $type;
            my ($start, $stop) = @{ $comment_style{$mime_type{$type}||''} || [] };
            if ($start or $stop) {
                return sub {
                    my $chunk = shift;
                    return unless defined $chunk;
                    my $comment = ref $self->comment eq 'CODE' ? $self->comment->($env) : $self->comment;
                    $chunk .= join ' ', $start, $comment, $stop;
                    return $chunk;
                };
            }
        }
    });
}

1;
__END__

=pod

=head1 NAME

Plack::Middleware::Watermark - Add watermark to response body

=head1 SYNOPSIS

  use Plack::Builder;
  my $app = sub {
      [ 200, [ 'Content-Type' => 'text/html' ], [ "Hello World\n" ] ]
  };
  builder {
      enable 'Watermark', comment => 'generated on my server';
      $app;
  }

  # Hello World
  # <!-- generated on my server -->

=head1 DESCRIPTION

The watermark middleware offers appending some string to response body as comment.

=head1 OPTIONS

=head2 comment

Specify comment string or subroutine returning some string.

  builder {
      enable 'Watermark', comment => sub { 'Generated by ' . Sys::Hostname::hostname };
      $app;
  }

=head1 AUTHOR

Hiroshi Sakai E<lt>ziguzagu@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright (C) 2010 Six Apart, Ltd. All rights reserved.

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut