Apache::FastForward - new age of spreadsheet web services

 package AAA::Demo;

 use Apache::Constants qw( :common );
 use Apache::FastForward;

 sub handler {

     my $r = Apache::FastForward->new( shift );

     my $user = $r->user();
     $r->send_http_header( 'text/plain' );

     $r->ParseBody();

     unless ( $r->IsDefinedTable( 'item', 'quantity' ) ){
            print 'Something went wrong...';
            return OK
     }

     my @item_quantity_table = $r->GetTable( 'item', 'quantity' );
     foreach my $row ( @item_quantity_table ){
          print $row->{item}}, $row->{quantity}
     }
 ...

package Apache::FastForward;
# Copyright 2006 Jerzy Wachowiak

use strict;
use warnings;
use vars qw( $VERSION );
use Text::CSV_XS;
use Encode qw( resolve_alias encode decode);

use Apache;
@Apache::FastForward::ISA = qw( Apache );

$VERSION = '1.1'; 

# PUBLIC METHODS (convention: capital first letter)

sub new {

# Contract:
#   [1] Input: $r for mod_perl subclassing ('r' or '_r' magic name)

    my $class = shift;
    my $r = shift;
     
    my $self = {};
    $self->{VERSION} = $VERSION;
    $self->{r} = $r; 
    $self->{csv} = Text::CSV_XS->new( {
                    'quote_char'  => '"',
                    'escape_char' => '"',
                    'sep_char'    => ';',
                    'binary'      => 1 } ); # Needed by encoding of non ASCI characters!
    $self->{tables} = undef;    
    bless ( $self, $class );
    return $self
}

sub ParseBody {

# Contract:
#   [1] Input: Encoding (if nothing defaults to UTF-8)
#   [2] Output: returning success (1) or failure(0)

    my $self = shift;
    my $document_charset = shift;

    $document_charset = 'UTF-8' unless defined( $document_charset );
    resolve_alias( $document_charset ) or return 0;
    
    $self->read( my  $content, $self->header_in( 'Content-length' ) );    
    $content = decode( $document_charset, $content );
    
    my ( @variable_names, $header_key );  
    my @lines = split( /\n/, $content );
    for my $line ( @lines ){
      
        chomp( $line );
        next unless length( $line );
        
        if ( $self->{csv}->parse( $line ) ){
            my ( $steering_cell, @cells ) = $self->{csv}->fields();
            $steering_cell = lc( trim( $steering_cell ) );
        
            if ( $steering_cell eq 'post'){            
                
                undef( @variable_names );
                for my $cell ( @cells ){
                    $cell = trim( $cell )                  
                }                
                next if length( join( '', @cells ) ) == 0; 
                
                @variable_names = @cells;                                
                undef( $header_key );                
                $header_key = build_header_key( @variable_names );
                unless ( exists( $self->{tables}->{$header_key} ) ){                    
                    $self->{tables}->{$header_key} = undef                
                }
            }
            elsif ( $steering_cell eq 'value'){
            
                @variable_names or next;
            
                my %variable_value;
                my $index;
                for ( $index = 0; $index < scalar( @variable_names ); $index++ ){
                    my $value = $cells[$index];                    
                    if ( defined( $value ) ){
                        $value = trim( $value );
                        $variable_value{$variable_names[$index]} = $value  
                    }
                    else {
                        $variable_value{$variable_names[$index]} = undef
                    }                           
                }
                push( @{$self->{tables}->{$header_key}}, \%variable_value );                
            }
            else {
                next
            } #if ( $steering_cell eq 'post'){     
        }
        else {
            return 0
        } #if ( $self->{csv}->parse( $line ) ){        
    } #for my $line ( @lines ){
    return 1 
}

sub GetTable {

# Contract:
#   [1] Input: column names, order does not matter
#   [2] Output: array of hashes [ {col1=> var11, col2=>var12}, {col1=> var21, col2=>var22} ] 
#       or undef if nothing exists
    
    my ( $self, @column_headers ) = @_;

    my $header_key = build_header_key( @column_headers );
    if ( defined( $self->{tables}->{$header_key} ) ){
        return @{$self->{tables}->{$header_key}}
    }
    else {
        return undef
    }    
}

sub IsBodyEmpty {

# Contract:
#   [1] Input->no (parsed body is passed via the class instance)
#   [2] Output: check success (1) or failure(0)  
    
    my $self = shift;
    
    return not defined( $self->{tables} )
}

sub IsDefinedTable {

# Contract:
#   [1] Input: column names, order does not matter
#   [2] Output: check success (1) or failure(0)

    my ( $self, @column_headers ) = @_;

    my $header_key = build_header_key( @column_headers );
    
    return defined( $self->{tables}->{$header_key} )

}

sub IsDefinedHeader {

# Contract:
#   [1] Input: column names, order does not matter
#   [2] Output: check success (1) or failure(0)

    my ( $self, @column_headers ) = @_;

    my $header_key = build_header_key( @column_headers );
    
    return exists( $self->{tables}->{$header_key} )
}

sub ListHeaders {

# Contract:
#   [1] Input: last parsed body private via class instance 
#   [2] Output: array of headers or undef if nothing

    my $self = shift;

    return keys( %{$self->{tables}} )
}

sub ListTables {

# Contract:
#   [1] Input: last parsed body private via class instance 
#   [2] Output: array of headers or undef if nothing

    my $self = shift;

    my @tables;
    my @headers = keys( %{$self->{tables}} );
    foreach my $header ( @headers ){
	push( @tables, $header ) if $self->IsDefinedTable( $header )
    }
    
    return @tables
}


# PRIVATE METHODS (convention: small_letters) 

sub build_header_key{
  
    my @column_headers = @_;
        
    @column_headers = sort( @column_headers );
    my $header_key = join( '|', @column_headers );
      
    return $header_key    
}

sub trim {
    
    my $string =  shift;
    
    $string =~ s/^\s+//;
    $string =~s/\s+$//;
    
    return $string   
}
1
__END__
######################## User Documentation ##################