view release on metacpan or  search on metacpan

Export.pm  view on Meta::CPAN

sub export {
	my $self = shift;
	my $what = shift || "contacts";  
	unless( $scopes{$what} ) {
		die "No such scope to export: $what";
	}
	$self->do_connect();
	$self->send_request($what);
	$self->get_response($what);
	my $sock = $self->{"sock"};
	$sock->close();
}

sub send_request {
	my $self = shift;
	my $what = shift;
	if( ! $self->{"cfg"}->{"username"} ) {
		die "No Username given!";
	}
	if( ! $self->{"cfg"}->{"password"} ) {
		die "No Password given!";
	}
	if( ! $self->{"cfg"}->{"client"} ) {
		$self->{"cfg"}->{"client"} = uc($ENV{"hostname"}) || sprintf("%s-%0.5i", "Acme-PIA-Export", rand(99999));
	}
	my $requestbody = "$self->{cfg}->{username}~;~$self->{cfg}->{password}~;~$self->{cfg}->{client}~;~$scopes{$what};~export~;~O~;~~#~";
	my $content_length = length($requestbody);
	
	my $request =	"POST $query_url HTTP/1.1\n" .
			"Pragma: no-cache\n" .
			"Host: www.arcor.de\n" .
			"Accept-Ranges: bytes\n" .
			"Content-Type: text/html\n" .
			"Content-Length: $content_length\n" .
			"\n" .
			$requestbody;
	if( $self->{"cfg"}->{"DEBUG"} ) {
		print "Sending request:$/$request$/-------------------------------$/";
	}
	my $sock = $self->{"sock"};
	my $res = print $sock $request;
	die "Failed writing to Socket on $server:80 (Error: $!)" unless( $res );
}



sub get_response {
	my $self = shift;
	my $what = shift;
	
	my $head = 1;
	my $return_head;
	my $return_body;
	my $bodysize;
	my $read_chunked = 1;
	
	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}};
}