view release on metacpan or  search on metacpan

lib/Apache/FastForward.pm  view on Meta::CPAN

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