view release on metacpan or  search on metacpan

Mappoint.pm  view on Meta::CPAN

			}
		)
		;
#	when autotype is switched of, also character escaping is switched off :-/
#	we added encoding in the handle_*_parameter methods.
	$self->{remote_object}->serializer()->autotype(0);

	if ( $ini_files->{$self->{ini_file}}{debug}{readable} ) {

		$self->{remote_object}->serializer()->readable(1);
	}

	return $self;
}

##############################################################################
# Set header info
sub set_CustomLogEntry { $_[0]->{CustomerInfoHeader}{CustomLogEntry} = $_[1]; }
sub set_CultureName { $_[0]->{UserInfoHeader}{Culture}{Name} = $_[1]; }
sub set_CultureLCID { $_[0]->{UserInfoHeader}{Culture}{LCID} = $_[1]; }
sub set_DefaultDistanceUnit { $_[0]->{UserInfoHeader}{DefaultDistanceUnit} = $_[1]; }
sub set_ContectGeoID { $_[0]->{UserInfoHeader}{Context}{GeoID} = $_[1]; }
sub set_ContectGeoISO2 { $_[0]->{UserInfoHeader}{Context}{GeoISO2} = $_[1]; }
##############################################################################
sub method {
	my ($self, $name, %args) = @_;

	# we need to set the credentials to be used in this call
	# so that SOAP::Transport::HTTP::Client::get_basic_credentials
	# returns the ones corresponding to the ini-file of this 
	# object --How else could we achieve this that is less convoluted?
	$user = $ini_files->{$self->{ini_file}}{user};
	$password = $ini_files->{$self->{ini_file}}{password};

	return $self->{remote_object}
		->call(
			SOAP::Data->name($name)
			->attr({ xmlns => $ini_files->{$self->{ini_file}}{xmlns} }) 
				=> (@{handle_parameters(%args)}, @{$self->header()})
		      );
}
##############################################################################
sub header {
	my ($self) = @_;

	# handle data from ini-file
	if ($ini_files->{$self->{ini_file}}{culture}) {
		$self->{UserInfoHeader} ||= {};
		$self->{UserInfoHeader}{Culture} ||= {};
		map( $self->{UserInfoHeader}{Culture}{$_} ||= $ini_files->{$self->{ini_file}}{culture}->{$_}, keys %{$ini_files->{$self->{ini_file}}{culture}} );
	}

	if ($ini_files->{$self->{ini_file}}{userinfoheader} ) {
		$self->{UserInfoHeader} ||= {};
		map($self->{UserInfoHeader}{$_} ||= $ini_files->{$self->{ini_file}}{userinfoheader}->{$_}, keys %{$ini_files->{$self->{ini_file}}{userinfoheader}});
	}

	my @header = ();;
	if ($self->{CustomerInfoHeader}) {
		push(@header, 
			SOAP::Header->name('CustomerInfoHeader' => \SOAP::Header->value(
				@{handle_header_parameters(%{$self->{CustomerInfoHeader}})}
			))->attr({xmlns => $ini_files->{$self->{ini_file}}{xmlns}})
		);
	}
	if ($self->{UserInfoHeader}) {
		my @param;
		push(@header, 
			SOAP::Header->name('UserInfoHeader' => \SOAP::Header->value(
				@{handle_header_parameters(%{$self->{UserInfoHeader}})}
			))->attr({xmlns => $ini_files->{$self->{ini_file}}{xmlns}})
		);
	}

	return \@header;
}
##############################################################################
sub parse_ini_file {
    my $fname = shift;

    # don't do anything if file has already been parsed
    if ( exists $ini_files->{$fname}{user} ) { return }
    
    my $fh = new FileHandle($fname, 'r');
    die "No ini-file ($fname) found\n" if (!$fh);
    
    my (%sec, $sec);
    while(my $line = <$fh>) {
	$line = strip($line);
	next if (substr($line, 0, 1) eq ';');
	if ($line =~ m/^\[/ && $line =~ m/\]$/) {
	    $sec = lc(strip(substr($line,1,length($line)-2)));
	}
	elsif ($line =~ m/=/) {
	    die "put [section]-line in the ini-file\n" if (!$sec);
	    my ($param,$value) = ($line =~ m/(\S+)\s*=\s*(\S*)$/);
	    $sec{$sec} ||= {};
	    $sec{$sec}{$param} = $value;
	}
	else {
	    die "Weird line in mappoint.ini: $line\n" if ($line !~ m/^\s*$/);
	}
    }
    die "No credentials section in ini-file\n" if (!$sec{credentials});
    $ini_files->{$fname}{xmlns} = $sec{general}{xmlns}
    || die "put a 'xmlns=...' in the general section in the ini-file\n";
    $ini_files->{$fname}{user} = $sec{credentials}{user} 
    || die "put 'user=...' in credentials section in ini-file\n";
    $ini_files->{$fname}{password} = $sec{credentials}{password} 
    || die "put 'password=...' in credentials section in ini-file\n";
    $ini_files->{$fname}{proxy} = $sec{proxy};
    $ini_files->{$fname}{culture} = $sec{culture};
    $ini_files->{$fname}{debug} = $sec{debug};
    $ini_files->{$fname}{userinfoheader} = $sec{userinfoheader};
}

##############################################################################
sub strip { my $s = shift; $s =~ s/^\s+//; $s =~ s/\s+$//; return $s }
##############################################################################
sub encode { SOAP::Utils::encode_data(@_); }
##############################################################################
sub handle_header_parameters {
	my (%args) = @_;
	my @parameters;
	foreach my $k (keys %args) {
		if (ref($args{$k}) eq 'HASH') {
			push(@parameters, SOAP::Header->name($k => \SOAP::Header->value(
				@{handle_header_parameters(%{$args{$k}})}
			)));
		}
		else {
			push(@parameters, SOAP::Header->name($k => encode($args{$k})));
		}
	}
	return \@parameters;
}
##############################################################################
sub handle_parameters {
	my (%args) = @_;
	my @parameters;
	foreach my $k (keys %args) {
		if (ref($args{$k}) eq 'ARRAY') {
			my @data = @{$args{$k}};
			my @params;
			while (scalar(@data) > 0) {
				my ($key, $value) = (shift(@data), shift(@data));
				push(@params, @{handle_parameters($key => $value)});
			}

			if( $k =~ /:/ ) {
			    my( $type, $subtype ) = split( /:/, $k );
			    
			    push(@parameters, SOAP::Data->name( $type => \SOAP::Data->value(
											    @params
											   ) )->attr( { 'xsi:type' => $subtype } ) );
			    
			} else {
			    
			    push(@parameters, SOAP::Data->name($k => \SOAP::Data->value(
											@params
										       )));
			}
		}
		elsif (ref($args{$k}) eq 'HASH') {
			push(@parameters, SOAP::Data->name($k)->attr( $args{$k}));
		}
		else {
#			if ($args{$k} eq 'true' || $args{$k} eq 'false') {
#				push(@parameters, SOAP::Data->name($k => $args{$k})->type('bool'));
#			}
#			else {
				push(@parameters, SOAP::Data->name($k => encode($args{$k})));
#			}
		}
	}

#	use Data::Dumper;
#	print STDERR "PARAMETROS:\n";
#	print STDERR Dumper(\@parameters);

	return \@parameters;
}
##############################################################################
sub drawmap_for_country {
	# take last argument, so that this method can be use as function as well
	# as class/instance method
	my $country = lc(pop(@_));
	print STDERR ("country code: $country\n");
	map($EU{$_}=1, @EU) if (!exists($EU{nl}));
	return 'MapPoint.EU' if $EU{$country};
	return 'MapPoint.NA' if $NA{$country};
	return 'MapPoint.World';