view release on metacpan or  search on metacpan

lib/Apache/Filter.pm  view on Meta::CPAN

  #warn "Turning STDOUT (@{[ref tied *STDOUT]}) into fh_in";
  delete $self->{'fh_in'};
  $self->{'fh_in'} = gensym;
  tie *{$self->{'fh_in'}}, ref($self), tied *STDOUT;
  local $^W;  # Ignore "untie attempted while %d inner references still exist" warning from next line
  untie *STDOUT;
}

sub filter_input {
  my $self = shift;

  # Don't handle directories
  if ($self->is_first_filter and -d $self->finfo) {
    $self->{'is_dir'} = 1; # Let mod_dir handle it
  }
  if ($self->{'is_dir'}) {
    $self->{fh_in} = undef;
    return wantarray ? ($self->{fh_in}, DECLINED) : $self->{fh_in};
  }

  my $status = OK;
  
  unless (exists $self->{fh_in}) {
    # Open $self->filename
    #warn "+++++++++++ @{[$self->filename]}: This is the first filter";
    $self->{fh_in} = gensym;
    if (not -e $self->finfo) {
      $self->log_error($self->filename() . " not found");
      $status = NOT_FOUND;
    } elsif ( not open (*{$self->{'fh_in'}}, $self->filename()) ) {
      $self->log_error("Can't open " . $self->filename() . ": $!");
      $status = FORBIDDEN;
    }
  }

  #warn "END info is @{[%$self]} ";
  return wantarray ? ($self->{fh_in}, $status) : $self->{fh_in};
}

sub is_last_filter {
  my $self = shift;
  return $self->{count} == @{$self->get_handlers('PerlHandler')};
}

sub is_first_filter {
  my $self = shift;
  return $self->{count} == 1;
}

sub send_http_header {
  my $self = shift;
  unless ($self->is_last_filter) {
    # This lets previous filters set content_type, which becomes default for final filter.
    $self->content_type($_[0]) if @_;

    # Prevent early filters from messing up the content-length of late filters
    $self->header_out('Content-Length'=> undef);
    return;
  }

  return $self->SUPER::send_http_header(@_);
}

sub send_fd {
  my $self = shift;
  if ($self->is_last_filter and eval{fileno $_[0]}) {
    # Can send native filehandle directly to client
    $self->SUPER::send_fd(@_);
  } else {
    my $fd = shift;
    print while <$fd>;
  }
}

sub print {
  my $self = shift;
  $self->send_http_header() unless $self->sent_header;
  print STDOUT @_;
}

sub changed_since {
    my $self = shift;
    # If any previous handlers are non-deterministic, then the content is 
    # volatile, so tell them it's changed.

    if ($self->{'count'} > 1) {
        return 1 if grep {not $self->{'determ'}{$_}} (1..$self->{'count'}-1);
    }
    
    # Okay, only deterministic handlers have touched this.  If the file has
    # changed since the given time, return true.  Otherwise, return false.
    return 1 if ((stat $self->finfo)[9] > shift);
    return 0;
}

sub deterministic {
    my $self = shift;

    if (@_) {
        $self->{'determ'}{$self->{'count'}} = shift;
    }
    return $self->{'determ'}{$self->{'count'}};
}

# This package is a TIEHANDLE package, so it can be used like this:
#  tie(*HANDLE, 'Apache::Filter');
# All it does is save strings that are written to the filehandle, and
# spits them back out again when you read from the filehandle.

sub TIEHANDLE {
    my $class = shift;
    my $self = (@_ ? shift : { content => '' });
    return bless $self, $class;
}

sub PRINT {
    shift()->{'content'} .= join "", @_;
}

sub PRINTF {
    my $self = shift;
    my $format = shift;
    $self->{'content'} .= sprintf($format, @_);
}

sub READLINE {
    # I've tried to emulate the behavior of real filehandles here
    # with respect to $/, but I might have screwed something up.