...
 
Commits (3)
......@@ -68,6 +68,10 @@ if (KDESRC_BUILD_INSTALL_MODULES)
modules/ksb/Updater/KDEProjectMetadata.pm
modules/ksb/Updater/Svn.pm
DESTINATION ${KDESRC_BUILD_MODULE_INSTALL_PREFIX}/ksb/Updater)
install(FILES
modules/ksb/WebAPI/KDEProjects.pm
DESTINATION ${KDESRC_BUILD_MODULE_INSTALL_PREFIX}/ksb/WebAPI)
endif()
install(PROGRAMS ${CMAKE_CURRENT_SOURCE_DIR}/kdesrc-build DESTINATION ${BIN_INSTALL_DIR})
......
......@@ -7,7 +7,7 @@
# Please also see the documentation that should be included with this program,
# in the doc/ directory.
#
# Copyright © 2003 - 2015 Michael Pyne. <mpyne@kde.org>
# Copyright © 2003 - 2016 Michael Pyne. <mpyne@kde.org>
# Home page: http://kdesrc-build.kde.org/
#
# Copyright © 2005, 2006, 2008 - 2011 David Faure <faure@kde.org>
......@@ -40,7 +40,7 @@ use lib "$RealBin/modules";
# through require/eval/etc. by using the "caller" function.
package main;
use strict;
use 5.14.0;
use warnings;
use Carp;
......@@ -53,8 +53,6 @@ use ksb::Util;
use ksb::Version qw(scriptVersion);
use ksb::Application;
use 5.014; # Require Perl 5.14
# Make Perl 'plain die' exceptions use Carp::confess instead of their core
# support. This is not supported by the Perl 5 authors but assuming it works
# will be better than the alternative backtrace we get (which is to say, none)
......
package ksb::Util;
package ksb::Util 0.20;
# Useful utilities, which are exported into the calling module's namespace by default.
use 5.014; # Needed for state keyword
use 5.14.0; # Needed for state keyword
use strict;
use warnings;
our $VERSION = '0.10';
use Carp qw(cluck);
use Scalar::Util qw(blessed);
use File::Path qw(make_path);
......@@ -27,7 +25,7 @@ our @EXPORT = qw(list_has assert_isa assert_in any unique_items
download_file absPathToExecutable
fileDigestMD5 log_command disable_locale_message_translation
split_quoted_on_whitespace safe_unlink safe_system p_chdir
pretend_open safe_rmtree get_list_digest
pretend_open safe_rmtree get_list_digest construct_http_ua
super_mkdir filter_program_output prettify_seconds);
# Function to work around a Perl language limitation.
......@@ -582,6 +580,23 @@ sub split_quoted_on_whitespace
return parse_line('\s+', 0, $line);
}
# This subroutine obtains an HTTP::Tiny object already setup to kdesrc-build
# specific options (such as User-Agent header, proxy support, etc.). A hash
# can be passed in, whose options will be applied in HTTP::Tiny->new
sub construct_http_ua
{
my %override_opts = @_;
my $scriptVersion = scriptVersion();
my %opts = (
# Trailing space adds lib version info
agent => "kdesrc-build/$scriptVersion ",
timeout => 30,
%override_opts,
);
return HTTP::Tiny->new(%opts);
}
# This subroutine downloads the file pointed to by the URL given in the
# first parameter, saving to the given filename. (FILENAME, not
# directory). HTTP and FTP are supported, but this functionality requires
......@@ -595,19 +610,13 @@ sub download_file
{
my ($url, $filename, $proxy) = @_;
my $scriptVersion = scriptVersion();
my %opts = (
# Trailing space adds lib version info
agent => "kdesrc-build/$scriptVersion ",
timeout => 30,
);
my %opts;
if ($proxy) {
whisper ("Using proxy $proxy for HTTP downloads");
$opts{proxy} = $proxy;
}
my $http_client = HTTP::Tiny->new(%opts);
my $http_client = get_http_ua(%opts);
whisper ("Downloading g[$filename] from g[$url]");
my $response = $http_client->mirror($url, $filename);
......
package ksb::WebAPI::KDEProjects 0.10
{
# This class consolidates the code handling the new-style REST API to be used to support
# obtaining information about the various KDE git repositories (something previously done
# by downloading a large XML file and breaking it apart).
#
# The intent is that this would be used by the $ctx (or something similar) and would be a simple
# wrapper around the API defined at https://community.kde.org/Sysadmin/Project_Metadata_API
#
# TODO: Needless to say, there's much more to do to get this finished.
use 5.14.0;
use warnings;
use HTTP::Tiny;
use JSON::PP;
use ksb::Debug;
use ksb::BuildException;
use ksb::Util;
my $api_url = 'https://apps.kde.org/api/v1';
# Internal. Gets a JSON response for the given URL, and throws an exception
# based on the given error message if the request fails. Call as $self->_get...
sub _getJSONResponse
{
my ($self, $url, $msg) = @_;
my $resp = $self->{ua}->get($url);
croak_runtime("$msg!\n\t" . $resp->{reason}) unless $resp->{success};
return $resp;
}
sub new
{
my ($class) = @_;
my $self = {
ua => construct_http_ua(),
};
assert_isa($self->{ua}, 'HTTP::Tiny');
return bless $self, $class;
}
# Makes API call to KDE Projects API web service, and:
# if successful, returns list of current KDE project components
# if an error occurs, throws an exception
sub components
{
my $self = shift;
my $resp = $self->_getJSONResponse(
"$api_url/components",
"Unable to load list of KDE software components from KDE web servers!");
return @{decode_json ($resp->{content})};
}
# Makes API call to KDE Projects API web service, and:
# if successful, returns hashref containing metadata about the single KDE
# project asked about
# if an error occurs, throws an exception
#
# Only parameter is name (not project path) of the project to retrieve
# information on (e.g. 'juk')
sub projectMetadata
{
my ($self, $projectName) = @_;
croak_internal("Invalid project name $projectName")
unless $projectName =~ /^[a-zA-Z0-9_-]+$/;
my $resp = $self->_getJSONResponse(
"$api_url/repo/$projectName",
"Unable to retrieve information on $projectName from KDE servers!");
return decode_json($resp->{content});
}
} # end package
1;