[Socialtext-commits] SF.net SVN: socialtext: [993] branches/rug

[<pet...@us...>]

Revision: 993
          http://svn.sourceforge.net/socialtext/?rev=993&view=rev
Author:   petdance
Date:     2007-01-29 23:07:05 -0800 (Mon, 29 Jan 2007)

Log Message:
-----------
Moved the WebHelpers subclass into WebHelpers.pm.  They shoudl eventually become part of the rug

Modified Paths:
--------------
    branches/rug/lib/Socialtext/Handler/WSDL.pm
    branches/rug/lib/Socialtext/WebHelpers.pm

Removed Paths:
-------------
    branches/rug/lib/Socialtext/WebHelpers/
    branches/rug/t/Socialtext/WebHelpers/

Modified: branches/rug/lib/Socialtext/Handler/WSDL.pm
===================================================================
--- branches/rug/lib/Socialtext/Handler/WSDL.pm	2007-01-30 06:53:17 UTC (rev 992)
+++ branches/rug/lib/Socialtext/Handler/WSDL.pm	2007-01-30 07:07:05 UTC (rev 993)
@@ -7,7 +7,7 @@
 use File::Spec::Functions qw(catfile);
 use Socialtext::AppConfig;
 use Socialtext::URI;
-use Socialtext::WebHelpers::Rug ();
+use Socialtext::WebHelpers ();
 
 sub handler ($$) {
     my ( $class, $r ) = @_;
@@ -21,7 +21,7 @@
     my $wsdl = eval { slurp($file) };
     return NOT_FOUND unless defined $wsdl;
 
-    my $soap_server = Socialtext::WebHelpers::Rug->base_uri();
+    my $soap_server = Socialtext::WebHelpers->base_uri();
     $soap_server .= "/soap/$ver/";
     $wsdl =~ s/\@SOAP_SERVER\@/$soap_server/g;
 
@@ -34,7 +34,7 @@
 
 =head1 NAME
 
-Socialtext::Handler::WSDL - Generate WSDL files for SOAP.
+Socialtext::Handler::WSDL -- Generate WSDL files for SOAP
 
 =head1 DESCRIPTION
 

Modified: branches/rug/lib/Socialtext/WebHelpers.pm
===================================================================
--- branches/rug/lib/Socialtext/WebHelpers.pm	2007-01-30 06:53:17 UTC (rev 992)
+++ branches/rug/lib/Socialtext/WebHelpers.pm	2007-01-30 07:07:05 UTC (rev 993)
@@ -6,19 +6,13 @@
 
 use Socialtext::String;
 use URI::Escape ();
+use Carp ();
+use Socialtext::Rug ();
 
+
 my $SupportClass;
 my %Roles;
 BEGIN {
-    $SupportClass =
-        ( ( $ENV{MOD_PERL} && eval { require Apache::Request } and not $@ )
-          ? 'Socialtext::WebHelpers::Rug'
-          : 'Socialtext::WebHelpers::CGIpm'
-        );
-
-    eval "require $SupportClass";
-    die $@ if $@;
-
     %Roles = (
         base    => [ qw(
             uri_escape
@@ -31,8 +25,6 @@
             redirect
             print
             set_all
-            _get
-            _value
         ) ],
         cgi => [ qw(
             rug
@@ -63,7 +55,7 @@
         for my $meth ( @{ $Roles{$role} } ) {
             next if $exported{$meth};
 
-            my $class = __PACKAGE__->can($meth) ? __PACKAGE__: $SupportClass;
+            my $class = __PACKAGE__->can($meth) ? __PACKAGE__ : die "I can't $meth";
             {
                 no strict 'refs';
                 *{"$caller\::$meth"} = \&{"$class\::$meth"};
@@ -99,5 +91,134 @@
 }
 
 
+sub rug {
+    my $self = shift;
+
+    return $self->{rug} ||= Socialtext::Rug->instance;
+}
+
+# Headers role
+sub print {
+    my $self = shift;
+    my $content_type = $self->content_type;
+
+    $content_type .= '; charset=' . $self->charset
+        if $content_type =~ /^text/;
+    $self->rug->content_type($content_type);
+
+    for my $header ('Expires', 'Pragma', 'Cache-control', 'Last-modified') {
+        my $method = lc($header);
+        $method =~ tr/-/_/;
+        my $value = $self->$method;
+        $self->rug->header_out($header => $value) if defined $value;
+    }
+    $self->rug->send_http_header;
+}
+
+sub redirect {
+    my $self = shift;
+    if (@_) {
+        $self->rug->header_out(Location => shift);
+        $self->rug->status(302);
+    }
+    return $self->rug->header_out('Location');
+}
+
+sub set_all {
+    my $self = shift;
+    my %h = @_;
+
+    $self->rug->header_out($_ => $h{$_}) for keys %h;
+}
+
+# CGI role
+sub defined {
+    my $self = shift;
+    my $param = shift;
+    defined $self->rug->param($param);
+}
+
+sub names {
+    my $self = shift;
+    $self->rug->param;
+}
+
+sub full_uri {
+    my $self = shift;
+    my $uri = $self->_full_uri;
+
+    $uri->query(undef);
+
+    return $uri->unparse;
+}
+
+sub base_uri {
+    my $self = shift;
+    my $uri  = $self->_full_uri;
+
+    $uri->query(undef);
+    $uri->path(undef);
+
+    return $uri->unparse;
+}
+
+sub full_uri_with_query {
+    my $self = shift;
+    return $self->_full_uri->unparse;
+}
+
+sub _full_uri {
+    my $self = shift;
+    my $uri = $self->rug->parsed_uri;
+
+    $uri->hostname($self->rug->hostname);
+
+    my $xfh = $self->rug->header_in('X-Forwarded-Host');
+    if ( $xfh && ($xfh =~ /:(\d+)$/) ) {
+        my $front_end_port = $1;
+        if ( $front_end_port
+            && ($front_end_port != 80) && ($front_end_port != 443) ) {
+            $uri->port($front_end_port);
+        }
+    }
+    $uri->scheme( $self->rug->get_config('NLWHTTPSRedirect') ? 'https' : 'http' );
+
+    return $uri;
+}
+
+sub query_string {
+    my $self = shift;
+    $self->rug->args
+}
+
+sub path_info {
+    my $self = shift;
+    $self->rug->path_info
+}
+
+sub _get_cgi_param {
+    Carp::cluck( '_get_cgi_param called with undef as first param' )
+        unless defined $_[1];
+    my $self = shift; $self->rug->param(shift) }
+
+sub _get_upload {
+    my $self = shift;
+    my $name = shift;
+
+    my @handles = $self->rug->upload($name) or return;
+    my @uploads = ();
+    foreach my $handle (@handles) {
+        push @uploads,
+            {
+                handle => $handle->fh,
+                filename => $handle->filename,
+                %{$handle->info},
+            };
+    }
+
+    return @uploads if wantarray;
+    return $uploads[0];
+}
+
 1;
 


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.