view release on metacpan or  search on metacpan

Export.pm  view on Meta::CPAN

	
	my $sock = $self->{"sock"};
	
	LOOP: while( my $line = readline($sock) ) {
		(my $debugline = $line) =~ s/\r|\n//smg;
		print "Reading line from socket: $debugline$/" if( $self->{"cfg"}->{"DEBUG"} );
		if( $head && $line eq "\r\n" ) {
			$head = 0;
			last LOOP;
		} else {
			$return_head .= $line;
		}
	}
	$self->{"data"}->{"head"} = $return_head;
	if( $return_head =~ /Content-Length:\s(\d+)/sm ) {
		$bodysize = $1;
	} elsif( $return_head =~ /Transfer-Encoding:.chunked/sm ) {
		$read_chunked = 1;
	} else {
		die "Unable to parse Content-Length while chunked encoding not used in return header:\n$return_head";
	}
	if( $read_chunked ) {
		while( my $size = readline( $sock ) ) {
			$size =~ s/\r|\n//gsm;
			$size = hex($size);
			print "Reading Chunk of $size Bytes\n" if( $self->{"cfg"}->{"DEBUG"} );
			read($sock,my $return_buffer,$size) or last;
			$return_body .= $return_buffer;
			readline($sock);
		}
	} else {
		unless( read( $sock, $return_body, $bodysize ) ) {
			if( defined( $return_body ) ) {
				die "Unexpected end of input reading from socket $server:80!";
			} else {
				die "Error reading return data from socket $server:80 (Error: $!)";
			}
		}
	}
	my @rows = split /\r?\n/, $return_body;
	print "Got back " . scalar(@rows) . " rows of data$/" if( $self->{"cfg"}->{"DEBUG"} );
	$self->{"data"}->{"scope"} = $what;
	$self->{"data"}->{"rows"} = \@rows;
	$self->{"data"}->{"entries"} = ();
	foreach my $entry ( @rows ) {
		print "Processing entry $entry$/" if( $self->{"cfg"}->{"DEBUG"} );
		push @{$self->{"data"}->{"entries"}}, $self->parseentry( $entry, $what );
	}
	return scalar( @rows );
}

sub entries {
	my $self = shift;
	return @{$self->{"data"}->{"entries"}};
}

sub fields {
	my $self = shift;
	my $what = (@_)?shift:$self->{"data"}->{"scope"};
	
	die "No scope configured. Either pass as parameter or invoke fields() after a successful export." unless( $what );
	die "No such scope. Please check your spelling." unless( $ordered_fields{$what} );
	
	return @{$ordered_fields{$what}};
}

sub parseentry {
	my $self = shift;
	chomp(my $row = shift);
	my $what = shift;
	print "Parsing entry of type $what$/" if( $self->{"cfg"}->{"DEBUG"} );
	my %entry;
	$row =~ s/\r//;
	my @values = split /~;~/, $row;
	foreach( @{$ordered_fields{$what}} ) {
		print "Processing field $_ for type $what$/" if( $self->{"cfg"}->{"DEBUG"} );
		my $val = $values[$fields{$what}->{$_}];
		$entry{$_} = ($val ne "NULL")?$val:"";
	}
	return \%entry;
}

sub entries_csv {
	my $self = shift;
	my %parms = (scalar @_)?@_:();
	my $row0 = "";
	my @result;
	unless( defined($parms{"header"}) && $parms{"header"} == 0 ) {
		$row0 = join ";", @{$ordered_fields{$self->{"data"}->{"scope"}}};
	}
	if( $parms{"file"} ) {
		open( O, "> $parms{file}" ) or die $!;
		print O $row0.$/;
	} else {
		push @result, $row0;
	}
	my $count = 0;
	foreach my $entry ( $self->entries() ) {
		$count++;
		my @row;
		foreach my $field ( @{$ordered_fields{$self->{"data"}->{"scope"}}} ) {
			push @row, $entry->{$field};
		}
		if( $parms{"file"} ) {
			print O join(";", @row).$/;
		} else {
			push @result, join(";", @row);
		}
	}
	if( $parms{"file"} ) {
		close O;
		return $count;
	}
	return @result;
}

1;