view release on metacpan or  search on metacpan

Export.pm  view on Meta::CPAN

our %scopes = (
	"contacts"	=>	"contacts",
	"calendar"	=>	"calendar"
);

sub new {
	my $self = {};
	my $class = shift;
	bless $self, ref $class || $class;
	if( @_ ) {
		my %cfg = @_;
		foreach( keys %cfg ) {
			$self->{"cfg"}->{$_} = $cfg{$_};
		}
	}
	$self;
}


sub do_connect {
	my $self = shift;
	my $sock = new IO::Socket::INET(
		PeerAddr	=>	$server,
		PeerPort	=>	80,
		Proto		=>	'TCP'
	);
	die "Unable to connect to $server:80 (Error: $!)" unless( $sock );
	$sock->autoflush(1);
	$self->{"sock"} = $sock;
	$self;
}


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: $!)";
			}
		}
	}