Commits

Palmer, 2E0EOL  committed 90f38fb

Split off WWW work as separate component.

  • Participants
  • Parent commits 08cd7bb

Comments (0)

Files changed (2)

File BBBackupAgent.pm

 use warnings;
 use diagnostics;
 
-use lib '/opt/daybo/lib';
-
 package BBBackupAgent;
 use Data::Dumper;
-use DlConfReader;
-use LWP::UserAgent;
+use Daybo::ConfReader;
+use BBBackupWWWAgent;
 #----------------------------------------------------------------------------
 #our @ISA = qw(Exporter);
 our $VERSION = "0.0.1";
 use constant OPT_TYPE_CODEREF  => (4);
 use constant OPT_TYPE_REALFILE => (5);
 use constant OPT_TYPE_REALDIR  => (6);
-
-# API URI
-use constant BB_URI => 'https://api.bitbucket.org/1.0/user/repositories/';
 #----------------------------------------------------------------------------
 # Mappings between names of options and their types
 my %OptTypes = (
 sub Run($)
 {
 	my ( $req, $resp ); # Request, response
-	my $ua = LWP::UserAgent->new(); # user-agent for using web-service
+	my $wsa = BBBackupWWWAgent->new(); # Web-service agent
 	my $ret = 1; # fail (default)
 	my $self = shift;
 
-	$req = HTTP::Request->new(GET => BB_URI());
-	$resp = $ua->request($req);
-	die Dumper $resp;
+	#$req = HTTP::Request->new(GET => BB_URI());
+	$wsa->timeout(60);
+	#die unless ( $ua->is_protocol_supported('https') );
+	#$ua->ssl_opts(verify_hostname => 1); # Method missing?
+	#$resp = $wsa->request($req);
+	#if ( $resp->is_success() ) {
+	#	die 'success';
+	#} else {
+	#	die $resp->status_line();
+	#}
+	die 'FIXME';
 	return $ret;
 }
 #----------------------------------------------------------------------------

File BBBackupWWWAgent.pm

+#!/usr/bin/perl -w
+#
+# Bitbucket Backup Agent
+# Copyright (C) 2011 Daybo Logic
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+# 3. Neither the name of the project nor the names of its contributors
+#    may be used to endorse or promote products derived from this software
+#    without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED.  IN NO EVENT SHALL THE PROJECT OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+#----------------------------------------------------------------------------
+use strict;
+use warnings;
+use diagnostics;
+
+use lib '/opt/daybo/lib';
+
+package BBBackupWWWAgent;
+use LWP::UserAgent;
+#----------------------------------------------------------------------------
+our @ISA = qw(LWP::UserAgent);
+our $VERSION = "0.0.1";
+#----------------------------------------------------------------------------
+use constant BB_URI => 'https://api.bitbucket.org/1.0/user/repositories/';
+#----------------------------------------------------------------------------
+require LWP;
+
+#use URI;
+#----------------------------------------------------------------------------
+sub new
+{
+	my $self = LWP::UserAgent::new(BB_URI());
+	$self->agent('bb-backup-agent/' . $VERSION);
+	$self;
+}
+#----------------------------------------------------------------------------
+sub get_basic_credentials
+{
+	my($self, $realm, $uri) = @_;
+	my $netloc = $uri->host_port;
+	return ('daybologic', '???');
+}
+#----------------------------------------------------------------------------
+1;