File Coverage

blib/lib/Slash/Client.pm

Criterion	Covered	Total	%
statement	28	76	36.8
branch	5	30	16.6
condition	0	14	0.0
subroutine	6	10	60.0
pod	0	6	0.0
total	39	136	28.6

# This code is a part of Slash, and is released under the GPL.
# Copyright 1997-2005 by Open Source Technology Group. See README
# and COPYING for more information, or see http://slashcode.com/.
# $Id: Client.pm,v 1.1 2005/11/21 17:31:46 pudge Exp $

package Slash::Client;

use strict;
use warnings;

use Digest::MD5 'md5_hex';
use File::Spec::Functions;

our $VERSION = 0.01;

sub new {
	my($class, $opts) = @_;

	my $self = {};
	$self->{host} = $opts->{host} or return;
	$self->{http} = $opts->{ssl} ? 'https' : 'http';

	$self->{uid}  = $opts->{uid};
	$self->{pass} = $opts->{pass};
	$self->{logtoken}    = $opts->{logtoken};
	$self->{cookie_file} = $opts->{cookie_file};

	bless $self, $class;
	return $self;
}

sub soap {
	my($self) = @_;
	my $uri   = $self->{soap}{uri}   or return;
	my $proxy = $self->{soap}{proxy} or return;

	return $self->{soap}{cache} if $self->{soap}{cache};

	require HTTP::Cookies;
	require SOAP::Lite;

	my $cookies = HTTP::Cookies->new;

	if ($self->{logtoken}) {
		$cookies->set_cookie(0, user => $self->{logtoken}, '/', $self->{host});

	} elsif ($self->{uid} && $self->{pass}) {
		my $cookie = bakeUserCookie($self->{uid}, $self->{pass});
		$cookies->set_cookie(0, user => $cookie, '/', $self->{host});

	} else {
		my $cookie_file = $self->{cookie_file} || find_cookie_file();
		if ($cookie_file) {
			$cookies = HTTP::Cookies::Netscape->new;
			$cookies->load($cookie_file);
		}
	}

	my $soap = SOAP::Lite->uri($uri)->proxy($proxy, cookie_jar => $cookies);
	$self->{soap}{cache} = $soap;
	return $soap;
}


sub find_cookie_file {
	my $app = shift || 'Firefox';
	my $file;
	if ($^O eq 'MacOS' || $^O eq 'darwin') {
		require Mac::Files;
		Mac::Files->import(':DEFAULT');

		my($dir, $vref, $type);
		if ($^O eq 'darwin') {
			$vref = &kUserDomain;
			if ($app eq 'Chimera' || $app eq 'Firefox') {
				$type = &kApplicationSupportFolderType;
			} elsif ($app eq 'Mozilla') {
				$type = &kDomainLibraryFolderType;
			}
		} elsif ($^O eq 'MacOS') {
			$vref = &kOnSystemDisk;
			$type = &kDocumentsFolderType;
		}

		$dir = FindFolder($vref, $type, &kDontCreateFolder);
		$dir = catdir($dir, $app, 'Profiles');
		for (0, 1) {
			last if -e catfile($dir, 'cookies.txt');
			opendir(my $dh, $dir) or die "Can't open $dir: $!";
			$dir = catdir($dir, (grep !/^\./, readdir($dh))[0]);
			closedir($dh);
		}
		$file = catfile($dir, 'cookies.txt');
	}
	return $file;
}

sub bakeUserCookie {
	my($uid, $pass) = @_;
	my $cookie = $uid . '::' . md5_hex($pass);
	$cookie =~ s/(.)/sprintf("%%%02x", ord($1))/ge;
	$cookie =~ s/%/%25/g;
	return $cookie;
}

sub literal {
	my($str) = @_;
	$str =~ s/&/&/g;
	$str =~ s/
	$str =~ s/>/>/og;
	return $str;
}

sub fixparam {
	my($str) = @_;
	$str =~ s/([^$URI::unreserved])/$URI::Escape::escapes{$1}/og;
	return $str;
}

1;

__END__