Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

What up with $r->print not working for us in Apache::SSI? dunno. But …

…we'll do print instead.
  • Loading branch information...
commit 0f2e1fb91b5cf3a70c1532bde1b35337b276d0ba 1 parent 4f20734
Chris Nandor authored February 24, 2005
52  Slash/Custom/ApacheCompress/ApacheCompress.pm
@@ -24,8 +24,9 @@ use Apache::Constants qw(:common);
24 24
 
25 25
 sub handler {
26 26
   my $r = shift;
  27
+  
  28
+  my $can_gzip = can_gzip($r);
27 29
 
28  
-  my $can_gzip = $r->header_in('Accept-Encoding') =~ /gzip/;
29 30
   my $filter   = lc $r->dir_config('Filter') eq 'on';
30 31
   #warn "can_gzip=$can_gzip, filter=$filter";
31 32
   return DECLINED unless $can_gzip or $filter;
@@ -33,8 +34,8 @@ sub handler {
33 34
   # Other people's eyes need to check this 1.1 stuff.
34 35
   if ($r->protocol =~ /1\.1/) {
35 36
     my %vary = map {$_,1} qw(Accept-Encoding User-Agent);
36  
-    if (my @vary = $r->header_out('Vary')) {
37  
-      @vary{@vary} = ();
  37
+    if (my $vary = $r->header_out('Vary')||0) {
  38
+      $vary{$vary} = 1;
38 39
     }
39 40
     $r->header_out('Vary' => join ',', keys %vary);
40 41
   }
@@ -56,8 +57,8 @@ sub handler {
56 57
   if ($can_gzip) {
57 58
     $r->content_encoding('gzip');
58 59
     $r->send_http_header;
59  
-    local $/;
60  
-    print Compress::Zlib::memGzip(<$fh>);
  60
+#    $r->print( Compress::Zlib::memGzip(do {local $/; <$fh>}) );
  61
+    print( Compress::Zlib::memGzip(do {local $/; <$fh>}) );
61 62
   } else {
62 63
     $r->send_http_header;
63 64
     $r->send_fd($fh);
@@ -66,8 +67,47 @@ sub handler {
66 67
   return OK;
67 68
 }
68 69
 
69  
-1;
  70
+sub can_gzip {
  71
+  my $r = shift;
  72
+
  73
+  my $how_decide = $r->dir_config('CompressDecision');
  74
+  if (!defined($how_decide) || lc($how_decide) eq 'header') {
  75
+    return +($r->header_in('Accept-Encoding')||'') =~ /gzip/;
  76
+  } elsif (lc($how_decide) eq 'user-agent') {
  77
+    return guess_by_user_agent($r->header_in('User-Agent'));
  78
+  }
  79
+  
  80
+  die "Unrecognized value '$how_decide' specified for CompressDecision";
  81
+}
  82
+  
  83
+sub guess_by_user_agent {
  84
+  # This comes from Andreas' Apache::GzipChain.  It's very out of
  85
+  # date, though, I'd like it if someone sent me a better regex.
  86
+
  87
+  my $ua = shift;
  88
+  return $ua =~  m{
  89
+		   ^Mozilla/            # They all start with Mozilla...
  90
+		   \d+\.\d+             # Version string
  91
+		   [\s\[\]\w\-]+        # Language
  92
+		   (?:
  93
+		    \(X11               # Any unix browser should work
  94
+		    |             
  95
+		    Macint.+PPC,\sNav   # Does this match anything??
  96
+		   )
  97
+		  }x;
  98
+}
  99
+
70 100
 
71 101
 1;
72 102
 
  103
+
  104
+# Verbose version:
  105
+#    my $content = do {local $/; <$fh>};
  106
+#    my $content_size = length($content);
  107
+#    $content = Compress::Zlib::memGzip(\$content);
  108
+#    my $compressed_size = length($content);
  109
+#    my $ratio = int(100*$compressed_size/$content_size) if $content_size;
  110
+#    print STDERR "GzipCompression $content_size/$compressed_size ($ratio%)\n";
  111
+#    print $content;
  112
+
73 113
 __END__
33  Slash/Custom/ApacheSSI/ApacheSSI.pm
@@ -16,10 +16,26 @@ use strict;
16 16
 use base 'Apache::SSI';
17 17
 use vars qw($VERSION);
18 18
 
19  
-use Apache::Constants qw(:common OPT_INCNOEXEC);
  19
+use Apache::Constants qw(:common :http OPT_INCNOEXEC);
20 20
 
21 21
 ($VERSION) = ' $Revision$ ' =~ /\$Revision:\s+([^\s]+)/;
22 22
 
  23
+sub output {
  24
+    my $self = shift;
  25
+    
  26
+    my @parts = split m/(<!--#.*?-->)/s, $self->{'text'};
  27
+    while (@parts) {
  28
+#        $self->{_r}->print( ('', shift @parts)[1-$self->{'suspend'}[0]] );
  29
+        print( ('', shift @parts)[1-$self->{'suspend'}[0]] );
  30
+        last unless @parts;
  31
+        my $ssi = shift @parts;
  32
+        if ($ssi =~ m/^<!--#(.*)-->$/s) {
  33
+#            $self->{_r}->print( $self->output_ssi($1) );
  34
+            print( $self->output_ssi($1) );
  35
+        } else { die 'Parse error' }
  36
+    }
  37
+}
  38
+
23 39
 sub ssi_perl {
24 40
   my($self, $args, $margs) = @_;
25 41
   $args->{'sub'} =~ s/print Slash::getAd/Slash::getAd/;
@@ -41,17 +57,16 @@ sub ssi_include {
41 57
       $self->error("Include of ", $subr->filename, " failed: $!");
42 58
     }
43 59
   } else {
44  
-    unless ($subr->run == OK) {
45  
-      $self->error("Include of '@{[$subr->filename()]}' failed: $!");
  60
+    if ( $subr->status == HTTP_OK ) {
  61
+      # Subrequests can fuck up %ENV, make sure it's restored upon exit.
  62
+      # Unfortunately 'local(%ENV)=%ENV' reportedly causes segfaults.
  63
+      my %save_ENV = %ENV;
  64
+      $subr->run == OK
  65
+        or $self->error("Include of '@{[$subr->filename()]}' failed: $!");
  66
+      %ENV = %save_ENV;
46 67
     }
47 68
   }
48 69
   
49  
-  ## Make sure that all of the variables set in the include are present here.
50  
-  #my $env = $subr->subprocess_env();
51  
-  #foreach ( keys %$env ) {
52  
-  #  $self->{_r}->subprocess_env($_, $env->{$_});
53  
-  #}
54  
-  
55 70
   return '';
56 71
 }
57 72
 

0 notes on commit 0f2e1fb

Please sign in to comment.
Something went wrong with that request. Please try again.