[Rt-commit] [svn] r1612 - in experiments/websvk: . websvk websvk/html

jesse at pallas.eruditorum.org jesse at pallas.eruditorum.org
Mon Oct 4 15:28:50 EDT 2004


Author: jesse
Date: Mon Oct  4 15:28:49 2004
New Revision: 1612

Added:
   experiments/websvk/websvk/
   experiments/websvk/websvk/html/
   experiments/websvk/websvk/html/autohandler
   experiments/websvk/websvk/html/list.html
   experiments/websvk/websvk/standalone_httpd.in
Modified:
   experiments/websvk/   (props changed)
Log:
 r10377 at tinbook:  jesse | 2004-09-24T18:58:57.877732Z
 


Added: experiments/websvk/websvk/html/autohandler
==============================================================================
--- (empty file)
+++ experiments/websvk/websvk/html/autohandler	Mon Oct  4 15:28:49 2004
@@ -0,0 +1,21 @@
+<%init>
+require SVN::Core;
+require SVN::Repos;
+require SVN::Fs;
+use SVK::XD;
+use SVK::I18N;
+use SVK::Util qw(get_anchor);
+use Getopt::Long qw(:config no_ignore_case);
+use Cwd;
+use File::Spec;
+use Data::Hierarchy;
+use SVK::Command;
+my $svkpath = "$ENV{HOME}/.svk";
+ $SVK::XD = SVK::XD->new ( giantlock => "$svkpath/lock", statefile => "$svkpath/config");
+    $SVK::XD->load();
+
+$m->call_next();
+
+    $SVK::XD->store ();
+
+</%init>

Added: experiments/websvk/websvk/html/list.html
==============================================================================
--- (empty file)
+++ experiments/websvk/websvk/html/list.html	Mon Oct  4 15:28:49 2004
@@ -0,0 +1,4 @@
+%my ( undef, $path, $copath, undef, $repos ) = $SVK::XD->find_repos_from_co_maybe( '//', 1 );
+<ul>
+%$m->print( "<li>".$_ ) for ( sort keys %{ $repos->fs->revision_root( $repos->fs->youngest_rev )->dir_entries($path)});
+</ul>

Added: experiments/websvk/websvk/standalone_httpd.in
==============================================================================
--- (empty file)
+++ experiments/websvk/websvk/standalone_httpd.in	Mon Oct  4 15:28:49 2004
@@ -0,0 +1,143 @@
+#!/usr/bin/perl
+
+
+use HTML::Mason;
+use HTML::Mason::CGIHandler;
+
+
+use Socket;
+
+
+my $port = shift || '8080';
+    my $h = HTML::Mason::CGIHandler->new(
+        comp_root                    =>'/Users/jesse/svk/websvk/html'
+        ,
+        default_escape_flags => 'h',
+        allow_globals        => [qw(%session)],
+        autoflush => 1,
+    );
+
+
+main_loop($port);
+
+sub main_loop {
+    my $port = shift;
+    my $tcp  = getprotobyname('tcp');
+
+    socket( HTTPDaemon, PF_INET, SOCK_STREAM, $tcp ) or die "socket: $!";
+    setsockopt( HTTPDaemon, SOL_SOCKET, SO_REUSEADDR, pack( "l", 1 ) )
+      or warn "setsockopt: $!";
+    bind( HTTPDaemon, sockaddr_in( $port, INADDR_ANY ) ) or die "bind: $!";
+    listen( HTTPDaemon, SOMAXCONN ) or die "listen: $!";
+
+    print("You can connect to SVK at http://localhost:$port/\n");
+
+    while (1) {
+
+        for ( ; accept( Remote, HTTPDaemon ); close Remote ) {
+
+            *STDIN  = *Remote;
+            *STDOUT = *Remote;
+
+            my $remote_sockaddr = getpeername(STDIN);
+            my ( undef, $iaddr ) = sockaddr_in($remote_sockaddr);
+            my $peername = gethostbyaddr( $iaddr, AF_INET ) || "localhost";
+            my $peeraddr = inet_ntoa($iaddr) || "127.0.0.1";
+
+            my $local_sockaddr = getsockname(STDIN);
+            my ( undef, $localiaddr ) = sockaddr_in($local_sockaddr);
+            my $localname = gethostbyaddr( $localiaddr, AF_INET )
+              || "localhost";
+            my $localaddr = inet_ntoa($localiaddr) || "127.0.0.1";
+
+            chomp( $_ = <STDIN> );
+            my ( $method, $request_uri, $proto, undef ) = split;
+
+            #$request_uri =~ s#\\#/#g;
+            my ( $file, undef, $query_string ) =
+              ( $request_uri =~ /([^?]*)(\?(.*))?/ );    # split at ?
+            #$file =~ s/%([\dA-Fa-f]{2})/chr(hex($1))/eg;  # decode url-escaped entities
+
+            last if ( $method !~ /^(GET|POST|HEAD)$/ );
+
+            build_cgi_env( method       => $method,
+                           query_string => $query_string,
+                           path         => $file,
+                           method       => $method,
+                           port         => $port,
+                           peername     => $peername,
+                           peeraddr     => $peeraddr,
+                           localname    => $localname,
+                           request_uri  => $request_uri );
+
+            my $cgi = CGI->new();
+
+            print "HTTP/1.0 200 OK\n";    # probably OK by now
+            print STDERR $h->interp->comp_root."\n";
+            if ( ( !$h->interp->comp_exists( $cgi->path_info ) )
+                && ($h->interp->comp_exists( $cgi->path_info . "/index.html" ) )
+              ) {
+                $cgi->path_info( $cgi->path_info . "/index.html" );
+            }
+
+            eval { $h->handle_cgi_object($cgi); };
+
+        }
+
+    }
+
+}
+
+
+
+sub build_cgi_env {
+        my %args = ( query_string => '',
+                     path => '',
+                     port => undef,
+                     protocol => undef,
+                     localname => undef,
+                     method => undef,
+                     remote_name => undef,
+ 
+
+                        @_);
+                    
+        foreach my $var qw(USER_AGENT CONTENT_LENGTH CONTENT_TYPE
+          COOKIE SERVER_PORT SERVER_PROTOCOL SERVER_NAME
+          PATH_INFO REQUEST_URI REQUEST_METHOD REMOTE_ADDR
+          REMOTE_HOST QUERY_STRING SERVER_SOFTWARE) {
+            delete $ENV{$var};
+          }
+        while (<STDIN>) {
+            s/[\r\l\n\s]+$//;
+            if( /^([\w\-]+): (.+)/i) {
+                my $tag = uc($1);
+                $tag =~ s/^COOKIES$/COOKIE/;
+                my $val = $2;
+                $tag =~ s/-/_/g;
+                $tag = "HTTP_".$tag unless (grep /^$tag$/, qw(CONTENT_LENGTH CONTENT_TYPE COOKIE));
+                if ($ENV{$tag}) {
+                $ENV{$tag} .= "; $val";
+                }
+                else {
+                $ENV{$tag} = $val;
+                }
+            } 
+            last if (/^$/);
+        }
+
+
+        $ENV{SERVER_PROTOCOL} = $args{protocol};
+        $ENV{SERVER_PORT}     = $args{port};
+        $ENV{SERVER_NAME}     = $args{'localname'};
+        $ENV{SERVER_URL}      = "http://".$args{'localname'}.":".$args{'port'}."/";
+        $ENV{PATH_INFO}       = $args{'path'};
+        $ENV{REQUEST_URI}     = $args{'request_uri'};
+        $ENV{REQUEST_METHOD}  = $args{method};
+        $ENV{REMOTE_ADDR}     = $args{'peeraddr'};
+        $ENV{REMOTE_HOST}     = $args{'peername'};
+        $ENV{QUERY_STRING}    = $args{'query_string'};
+        $ENV{SERVER_SOFTWARE} = "rt-standalone/$RT::VERSION";
+
+        CGI::initialize_globals();
+} 


More information about the Rt-commit mailing list