view release on metacpan or  search on metacpan

QuickBase.pm  view on Meta::CPAN

Send an email from QuickBase inviting a user to an application. 

=back


=over 4

=item UserRoles($QuickBaseDBid)

Returns an Xml Document of information about the roles defined for an application.

=back



=head1 CLASS VARIABLES

None

=head1 DIAGNOSTICS

All errors are reported by the methods error and errortext. For a
complete list of errors, please visit
https://www.quickbase.com/up/6mztyxu8/g/rc7/en/ and scroll
down to Appendix A.

=head1 AUTHOR

Claude von Roesgen, claude_von_roesgen@intuit.com

=head1 COPYRIGHT

Copyright (c) 1999-2008 Intuit, Inc. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.


=cut

my %XMLescapes; 

sub new
{
    my $class = shift;
    my $prefix = shift;
    my $self;

	for (0..255) {
    	$XMLescapes{chr($_)} = sprintf("&#%03d;", $_);
	}

	$self = bless {
		'URLprefix' => $prefix || "https://www.quickbase.com/db" ,
		'ticket' => undef,
		'apptoken' => "",
		'error' => undef,
		'errortext' => undef,
		'username' => undef,
		'password' => undef,
		'credentials' => undef,
		'proxy' => undef,
		'realmhost' => undef
		}, $class;

}

sub authenticate ($$)
{
my($self, $username, $password) = @_;
	$self->{'username'} = $username;
	$self->{'password'} = $password;
	$username = $self->xml_escape($username);
	$password = $self->xml_escape($password);
	$self->{'credentials'} = "<username>$username<\/username><password>$password<\/password>";
	$self->{'ticket'}="";
	return "";
}

sub setAppToken($)
{
  my($self,$apptoken) = @_;
  $self->{'apptoken'} = $apptoken;
}

sub getTicket()
{
my($self) = @_;
    #First we have to get the authorization ticket
	#We do this by posting the QuickBase username and password to QuickBase
	#This is where we post the QuickBase username and password
	my $res = $self->PostAPIURL ("main", "API_Authenticate", 
		  "<qdbapi>".
			$self->{'credentials'}.
          "</qdbapi>");
	if ($res->content =~ /<errcode>(.*?)<\/errcode>.*?<errtext>(.*?)<\/errtext>/s)
		{
		$self->{'error'} = $1;
		$self->{'errortext'} = $2;
		}
	if ($res->content =~ /<errdetail>(.*?)<\/errdetail>/s)
		{
		$self->{'errortext'} = $1;
		}		
	if ($self->{'error'} eq '0')
		{
		$res->content =~ /<ticket>(.*?)<\/ticket>/s;
		$self->{'ticket'} = $1;
		$self->{'credentials'} = "<ticket>$self->{'ticket'}<\/ticket>";
		}
	else
		{
		return "";
		}
	return $self->{'ticket'};
}

sub URLprefix()
{
my($self) = shift;
if (@_)
	{
	$self->{'URLprefix'}=shift;
	$self->{'URLprefix'} =~ s/cgi\/sb.exe/db/;
	return $self->{'URLprefix'};
	}
else
	{
	return $self->{'URLprefix'};
	}
}

sub setProxy($)
{
my($self, $proxyserver) = @_;
$self->{'proxy'} = $proxyserver;
return $self->{'proxy'};	
}

sub setRealmHost($)
{
my($self, $realmhost) = @_;
$self->{'realmhost'} = $realmhost;
return $self->{'realmhost'};	
}

sub errortext()
{
my($self) = shift;
return $self->{'errortext'};	
}

sub error()
{
my($self) = shift;
return $self->{'error'};	
}

sub AddRecord($%)
{
my($self, $QuickBaseDBid, %recorddata) = @_;
my $name;
my $content;
my $filecontents;
my $filebuffer;
my $tag;

$content = "<qdbapi>";
foreach $name (keys(%recorddata))

QuickBase.pm  view on Meta::CPAN

my $action = shift;
my $content = shift;
my $content_type = shift || 'application/x-www-form-urlencoded';

my $ua = new LWP::UserAgent;
if ($self->{'proxy'}){
   $ua->proxy(['http','https'], $self->{'proxy'});
   }
$ua->agent("QuickBasePerlAPI/1.0");
my $req = new HTTP::Request;
$req->method("POST");
$req->uri($self->URLprefix."/$QuickBaseDBid?$action");
unless ($self->{'ticket'})
	{
	$self->{'ticket'}=$self->getTicket($self->{'username'},$self->{'password'});
	}
$req->header('Cookie' => "TICKET=$self->{'ticket'};");
$req->content_type($content_type);

#This is where we post the info for the new record

$req->content($content);
my $res = $ua->request($req);
if($res->is_error()){
	$self->{'error'} = $res->code;
	$self->{'errortext'} =$res->message;
	return $res;
}
$res->content =~ /<errcode>(.*?)<\/errcode>.*?<errtext>(.*?)<\/errtext>/s ;
$self->{'error'} = $1;
$self->{'errortext'} = $2;
if ($res->content =~ /<errdetail>(.*?)<\/errdetail>/s)
    {
    $self->{'errortext'} = $1;
	}		
return $res;
}

sub PostAPIURL($$$)
{
my($self, $QuickBaseDBid, $action, $content) = @_;
my $ua = new LWP::UserAgent;
$ua->agent("QuickBasePerlAPI/2.0");
if ($self->{'proxy'}){
   $ua->proxy(['http','https'], $self->{'proxy'});
   }
my $req = new HTTP::Request;
$req->method('POST');
if($self->{'realmhost'})
    {
    $req->uri($self->URLprefix()."/$QuickBaseDBid?realmhost=$self->{'realmhost'}");
    }
else
    {
    $req->uri($self->URLprefix()."/$QuickBaseDBid");
    }

$req->content_type('text/xml');
$req->header('QUICKBASE-ACTION' => "$action");

if ($self->{'apptoken'} ne "" && $self->{'credentials'} !~ /<apptoken>/)
   {
      $self->{'credentials'} .= "<apptoken>".$self->{'apptoken'}."</apptoken>";
   }

if($content =~ /^<qdbapi>/)
    {
    $content =~s/^<qdbapi>/<qdbapi>$self->{'credentials'}/;
    }
elsif($content eq "" || !defined($content)) 
    {
    $content ="<qdbapi>$self->{'credentials'}</qdbapi>";
    }
if($content =~ /^<qdbapi>/)
    {
    $content = "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>" . $content;
    }
my $res;
if ($self->{'ticket'})
    {
    $req->header('Cookie' => "TICKET=$self->{'ticket'};");
    }
    
$req->content($content);
$res = $ua->request($req);
if($res->is_error()){
        $self->{'error'} = $res->code;
$self->{'errortext'} =$res->message;
        return $res;
        }
if (defined ($res->header('Set-Cookie')) && $res->header('Set-Cookie') =~ /TICKET=(.+?);/)
        {
        $self->{'ticket'} = $1;
        $self->{'credentials'} = "<ticket>$self->{'ticket'}</ticket>";
        }
elsif ($res->content =~ /<ticket>(.+?)<\/ticket>/)
        {
        $self->{'ticket'} = $1;
        $self->{'credentials'} = "<ticket>$self->{'ticket'}</ticket>";
        }

$res->content =~ /<errcode>(.*?)<\/errcode>.*?<errtext>(.*?)<\/errtext>/s;
$self->{'error'} = $1;
$self->{'errortext'} = $2;
if ($res->content =~ /<errdetail>(.*?)<\/errdetail>/s)
    {
    $self->{'errortext'} = $1;
    }
if($self->{'error'} eq '11')
	{
    $self->{'errortext'} .= "\nXML request:\n" . $content;
	}
return $res;
}

sub getoneBaseIDbyName($)
{
my ($self, $dbName)= @_;
return $self->getIDbyName($dbName);
}

sub getIDbyName($)
{
my ($self, $dbName)= @_;
my $content;
$content = "<qdbapi><dbname>".$self->xml_escape($dbName)."</dbname></qdbapi>";
my $res = $self->PostAPIURL ("main", "API_FindDBByName", $content);

if($res->content =~ /<dbid>(.*)<\/dbid>/ ){
	return $1;
	}
else
	{
	return "";
	}
}

sub FindDBByName($)
{
   my ($self, $dbName)= @_;
   $self->getIDbyName($dbName);
}

sub cloneDatabase ($$$)
	{
	my ($self, $QuickBaseID, $Name, $Description)=@_;
	my $content;
	$content = "<qdbapi><newdbname>".$self->xml_escape($Name)."</newdbname><newdbdesc>".$self->xml_escape($Description)."</newdbdesc></qdbapi>";
	my $res = $self->PostAPIURL ($QuickBaseID, "API_CloneDatabase", $content);
	if($res->content =~ /<newdbid>(.*)<\/newdbid>/ ){
		return $1;
		}
	else
		{
		return "";
		}
	}

sub createDatabase ($$)