Upload progress through Perl instead of PHP

uploadprogress requires pecl extensions (uploadprogress or apc) but my hosting provider (a2hosting) does not install pecl modules (only pear).

so to fix that, i've heard perl could be capable

and it is, as it turned out

works like that:

1. add the following line to your .htaccess, above "Rewrite URLs of the form 'x' [...]":

   RewriteRule ^filefield/ahah/pictures/field_pictures/.* filefield-proxy.pl?q=$0 [L,QSA]

2. put the following code in a file called filefield-proxy.pl in the same directory, make it executeable
   

   #!/usr/bin/perl
   
   map { $ENV{$_} =~ s|/[^/]*$|/index.php| } ('SCRIPT_NAME', 'SCRIPT_FILENAME');
   open (PHP, "|/usr/bin/php", @ARGV ); # or maybe try "php-cgi" - HAS to output HTTP headers !
   while (<>) {
           print PHP;
           unless ( $s ) { $s++ if /^Content-Disposition: form-data; name="UPLOAD_IDENTIFIER"/; }
           else          { if ( $s == 1 ) { $s++ if m"\n"; } else { $/="\r\n"; chomp; $uid = $_; last; } }
   }
   die "Premature end of input" if eof;
   use IO::Socket::UNIX;
   $srv = new IO::Socket::UNIX ( Listen => 1, Local => "/tmp/perluploadprogress$uid" );
   die "Can't create UNIX Socket" unless $srv;
   $srv->blocking(0);
   while (1) {
           if ( $cln = $srv->accept ) {
                   $cln->print ( "$tr / " . $ENV{'CONTENT_LENGTH'} );
                   $cln->close;
           }
           last unless ( $nr = read STDIN, $in, 4096 );
           print PHP $in;
           $tr += $nr;
   }
   unlink $srv->hostpath;
   $srv->close;
   close PHP;
   wait;
   

3. apply the follwing patch to the filefield-6.x-3.7 module

   diff -ru filefield/filefield.module filefield-hack/filefield.module
   --- filefield/filefield.module  2010-06-29 21:37:29.000000000 -0400
   +++ filefield-hack/filefield.module     2010-08-09 23:48:53.000000000 -0400
   @@ -629,6 +629,15 @@
          $progress['percentage'] = round(100 * $status['current'] / $status['total']);
        }
      }
   +  elseif ($implementation == 'perl') {
   +    if ($ipc = socket_create(AF_UNIX, SOCK_STREAM, 0)) {
   +      if (file_exists($file = "/tmp/perluploadprogress$key") && socket_connect($ipc, $file) && ($pro = socket_read($ipc,512,PHP_NORMAL_READ))) {
   +         list($r, $t) = explode('/', $pro);
   +         $progress['message'] = t('Uploading... (@current of @total)', array('@current' => format_size($r), '@total' => format_size($t)));
   +         $progress['percentage'] = round(100 * $r / $t);
   +      }
   +    }
   +  }
   
      drupal_json($progress);
    }
   @@ -636,7 +645,7 @@
    /**
     * Determine which upload progress implementation to use, if any available.
     */
   -function filefield_progress_implementation() {
   +function filefield_progress_implementation() { return 'perl';
      static $implementation;
      if (!isset($implementation)) {
        $implementation = FALSE;
   diff -ru filefield/filefield_widget.inc filefield-hack/filefield_widget.inc
   --- filefield/filefield_widget.inc      2010-06-29 17:38:10.000000000 -0400
   +++ filefield-hack/filefield_widget.inc 2010-08-09 20:30:08.000000000 -0400
   @@ -342,7 +342,7 @@
      if ($progress_indicator != 'throbber' && $implementation = filefield_progress_implementation()) {
        $upload_progress_key = md5(mt_rand());
   
   -    if ($implementation == 'uploadprogress') {
   +    if ($implementation == 'uploadprogress' || $implementation == 'perl') {
          $element['UPLOAD_IDENTIFIER'] = array(
            '#type' => 'hidden',
            '#value' => $upload_progress_key,
   

   enjoy... ! (and maybe integrate the code properly...)

   cheers

   patrick