Transmission-Client-0.0804/0000755000175000017500000000000012420764571014202 5ustar olofolofTransmission-Client-0.0804/Makefile.PL0000644000175000017500000000152112420764417016152 0ustar olofolof# ex:ts=4:sw=4:sts=4:et use inc::Module::Install; name q(Transmission-Client); all_from q(lib/Transmission/Client.pm); # copy/paste from JSON-Any/Makefile.PL sub has_json () { our @order = qw(XS JSON DWIW); foreach my $testmod (@order) { $testmod = "JSON::$testmod" unless $testmod eq "JSON"; eval "require $testmod"; return 1 unless $@; } return 0; } unless (has_json) { requires 'JSON' => '2.02'; } else { feature 'JSON', -default => 0, 'JSON' => '2.02'; } requires q(DateTime) => 0.50; requires q(JSON::Any) => 1.20; requires q(LWP::UserAgent) => 5.8; requires q(MIME::Base64) => 3.00; requires q(Moose) => 0.80; requires q(MooseX::Types) => 0.20; requires q(Sub::Exporter) => 0.95; requires q(List::MoreUtils) => 0; test_requires q(Test::More) => 0; auto_install; WriteAll(sign => 1); Transmission-Client-0.0804/t/0000755000175000017500000000000012420764562014445 5ustar olofolofTransmission-Client-0.0804/t/00-load.t0000644000175000017500000000052712203634547015770 0ustar olofolof# ex:ts=4:sw=4:sts=4:et use lib qw(lib); use Test::More; plan tests => 8; use_ok('Transmission::AttributeRole'); use_ok('Transmission::Client'); use_ok('Transmission::Session'); use_ok('Transmission::Stats'); use_ok('Transmission::Torrent'); use_ok('Transmission::Torrent::File'); use_ok('Transmission::Types'); use_ok('Transmission::Utils'); Transmission-Client-0.0804/t/10-client.t0000644000175000017500000002166712203634547016340 0ustar olofolof# ex:ts=4:sw=4:sts=4:et use warnings; use strict; use lib qw(lib); use Test::More; use Transmission::Client; use JSON; $SIG{'__DIE__'} = \&Carp::confess; my($client, $rpc_response, $rpc_request, @torrents); my $rpc_response_code = 409; { no warnings 'redefine'; *LWP::UserAgent::post = sub { my($lwp, $url, %args) = @_; my $res = HTTP::Response->new; $rpc_request = $args{'Content'}; my($tag) = $rpc_request =~ /"tag":\s*(\d+)/; $rpc_response =~ s/"tag":\s*\w+/"tag":$tag/; $res->code($rpc_response_code); $res->content($rpc_response); $res->header('X-Transmission-Session-Id' => '1234567890') unless($client->session_id); $rpc_response_code = 200 if($rpc_response_code == 409); return $res; }; Transmission::Session->meta->add_method(read_all => sub {}); } { # generic $client = Transmission::Client->new(autodie => 1); is($client->_autodie, 1, 'Transmission::Client will die on error'); is($client->url, 'http://localhost:9091/transmission/rpc', 'default url is set'); is($client->_url, $client->url, 'default _url is without username/password'); isa_ok($client->_ua, 'LWP::UserAgent'); $rpc_response = '{ "tag": TAG, "result": "success", "arguments": 123 }'; is($client->session_id, '', 'session ID is not set until the first rpc() request'); is($client->rpc('foo_bar'), 123, 'rpc() request responded with 123'); request_has(method => 'foo-bar', 'foo_bar method was transformed to foo-bar'); is($client->session_id, '1234567890', 'session ID was set by mocked HTTP request'); $rpc_response = '{ "tag": TAG, "result": "success", "arguments": { "version": 42 } }'; is($client->version, 42, 'got mocked Transmission version'); } { # add my %args = ( download_dir => 'some/dir', paused => 1, peer_limit => 42, ); eval { $client->add }; like($@, qr{Need either filename or metainfo argument}, 'add() require filename or metainfo'); eval { $client->add(filename => 'foo', metainfo => 'bar') }; like($@, qr{Filename and metainfo argument crash}, 'add() cannot handle both filename and metainfo'); $rpc_response = '{ "tag": TAG, "result": "success", "arguments": 1 }'; ok($client->add(filename => 'foo.torrent'), 'add() torrent by filename'); request_has( arguments => { filename => "foo.torrent", }, method => "torrent-add", 'add() with filename'); ok($client->add(metainfo => {}), 'add() torrent with metainfo'); request_has( arguments => { metainfo => undef, }, method => "torrent-add", 'add() with metainfo'); } { # remove, move, start, stop, verify / _do_ids_action() eval { $client->remove }; like($@, qr{ids is required as argument}, 'remove() require ids argument'); ok(!$client->has_torrents, 'remove() does not clear "torrents" attribute on failure'); ok($client->remove(ids => 'all'), 'remove() with ids = "all"'); ok($rpc_request !~ /ids/, 'remove() did not pass on ids, when ids = "all"'); request_has(method => "torrent-remove", 'remove() does rpc method torrent-remove'); ok($client->remove(ids => 42), 'remove() can take a single id'); ok($client->remove(ids => [24, 42]), 'remove() can take a list of ids'); like($rpc_request, qr{[24,\s*42]}, 'remove() with list of ids'); ok(!$client->has_torrents, 'remove() also cleared "torrents" attribute'); eval { $client->move }; like($@, qr{location argument is required}, 'move() require "location"'); ok($client->move(location => '/some/path', ids => 42), 'move() with location and ids'); request_has( method => "torrent-set-location", arguments => { location => '/some/path', ids => [42], }, 'move() does rpc method torrent-set-location'); ok($client->start(ids => 42), 'start() with location and ids'); request_has( method => "torrent-start", arguments => { ids => [42], }, 'start() does rpc method torrent-start'); ok($client->stop(ids => 42), 'stop() with location and ids'); request_has( method => "torrent-stop", arguments => { ids => [42], }, 'stop() does rpc method torrent-stop'); ok($client->verify(ids => 42), 'verify() with location and ids'); request_has( method => "torrent-verify", arguments => { ids => [42], }, 'verify() does rpc method torrent-verify'); } { $rpc_response = '{ "tag": TAG, "result": "success", "arguments": { "torrents":[] } }'; is(my @torrents = $client->torrent_list, 0, 'torrent_list() contains zero objects'); is_deeply($client->torrents, \@torrents, 'torrent_list() returns a list, while "torrents" contains an array-ref'); $rpc_response = '{ "tag": TAG, "result": "success", "arguments": { "torrents":[] } }'; $client->read_torrents; request_has( method => 'torrent-get', arguments => { fields => [qw( creator uploadRatio leechers sizeWhenDone recheckProgress maxConnectedPeers activityDate id swarmSpeed peersConnected pieceCount torrentFile name isPrivate webseedsSendingToUs timesCompleted addedDate downloadedEver downloaders peersKnown seeders downloadDir startDate desiredAvailable status peersSendingToUs peersGettingFromUs rateDownload corruptEver leftUntilDone uploadedEver error rateUpload manualAnnounceTime doneDate totalSize dateCreated pieceSize percentDone errorString haveValid hashString eta haveUnchecked comment uploadLimit downloadLimit seedRatioMode bandwidthPriority downloadLimited seedRatioLimit uploadLimited honorsSessionLimits)] }, 'read_torrents() with all fields', ); $client->read_torrents(fields => [qw(name eta)]); request_has( method => 'torrent-get', arguments => { fields => [qw(id name eta)], }, 'read_torrents() with only specific fields', ); $client->read_torrents(lazy_read => 1); request_has( method => 'torrent-get', arguments => { fields => ["id"], }, 'read_torrents() with lazy_read', ); $client->read_torrents(ids => 42); request_has( method => 'torrent-get', arguments => { ids => [42], }, 'read_torrents() with ids', ); } { # RT#67691 $client->rpc(foo_bar => ids => [1,2,'foo']); like($rpc_request, qr{"ids":\[1,2,"foo"\]}, 'Fix RT#67691: id "foo" is still a string'); } TODO: { local $TODO = 'require better testing'; ok(!$client->has_session, 'client has no session'); ok($client->read_all, 'read_all() information'); ok($client->has_session, 'read_all() set session attribute'); } sub request_has { my $description = pop; my %args = @_; my @failed; note $description; # $rpc_request is set to the latest post request the test would have done my $rpc_req = decode_json($rpc_request); # All requests must have a method parameter ok exists $rpc_req->{method}, 'Existance of methods key'; for my $top (keys %args) { if (ref $args{$top}) { for my $key (keys %{$args{$top}}) { if (not defined $args{$top}->{$key}) { ok exists $rpc_req->{$top}->{$key}, "Existance of $top\->{$key}"; next; } if (not ref $rpc_req->{$top}->{$key} and not ref $args{$top}->{$key}) { is $rpc_req->{$top}->{$key}, $args{$top}->{$key}, "Comparing value for $top\->{$key}"; next; } is ref $rpc_req->{$top}->{$key}, 'ARRAY', "$top\->{$key} should be an array"; SKIP: { skip "See previous test failure", @{$args{$top}->{$key}} + 1 unless ref $rpc_req->{$top}->{$key} eq 'ARRAY'; # Make sure all expected values exist my %seen; for my $elm (@{$args{$top}->{$key}}) { ok( grep({$elm eq $_} @{$rpc_req->{$top}->{$key}}), "$top\->{$key} should have expected values ($elm)"); $seen{$elm} = 1; } # Make sure no unexpected values exist is_deeply [ grep {! exists $seen{$_}} @{$rpc_req->{$top}->{$key}}, ], [], "No unexpected elements found in $top\->{$key}"; } } } else { is $rpc_req->{$top}, $args{$top}, "Comparing value for $top"; } } } done_testing(); Transmission-Client-0.0804/t/10-torrent.t0000644000175000017500000000373612205160310016534 0ustar olofolof# ex:ts=4:sw=4:sts=4:et use warnings; use strict; use Test::More; use Transmission::Torrent; use Transmission::Client; use JSON; $SIG{'__DIE__'} = \&Carp::confess; my $client = Transmission::Client->new; my (%rpc_return, %rpc_callbacks); { no warnings 'redefine'; *Transmission::Client::rpc = sub { my $self = shift; my $method = shift; my $test = shift @{$rpc_callbacks{$method}}; $test->($self, $method, {@_}) if $test; return shift @{$rpc_return{$method}}; }; } my $torrent = new_ok 'Transmission::Torrent' => [ id => 1, client => $client, upload_ratio => 0.10, eta => 3.14, ]; is $torrent->upload_ratio, 0.10, "expected upload ratio (0.10)"; is $torrent->eta, 3, "expected upload ratio (3) (truncated double)"; # FIXME: ugly. :-( sub test_torrent_set { my %args = (@_); my $attr = $client->_camel2Normal($args{attribute}); push @{$rpc_return{'torrent-set'}}, {}; push @{$rpc_callbacks{'torrent-set'}}, $args{set_test}; push @{$rpc_return{'torrent-get'}}, { torrents => [ { $args{torrent}->id => { $args{attribute} => $args{value} } }, ] }; my $get_val = defined $args{coerced_val} ? $args{coerced_val} : $args{value}; is $torrent->$attr($args{value}), $get_val, 'get return should be the same as value supplied to set'; } test_torrent_set( torrent => $torrent, attribute => 'uploadLimit', value => '123', set_test => sub { my $self = shift; my ($method, $args) = @_; is_deeply $args->{ids}, [1], 'set should pass ids=[1]'; is $args->{uploadLimit}, 123, 'set should pass uploadLimit=123'; is encode_json([$args->{uploadLimit}]), encode_json([123]), 'JSON value for uploadLimit should be numeric'; }, post_test => sub { is shift, 123, 'get return should be same as arg to get' }, ); done_testing(); Transmission-Client-0.0804/t/00-pod-coverage.t0000644000175000017500000000031112203634547017413 0ustar olofolof# ex:ts=4:sw=4:sts=4:et use lib qw(lib); use Test::More; eval 'use Test::Pod::Coverage;1' or plan skip_all => 'Test::Pod::Coverage required'; all_pod_coverage_ok({ also_private => [ qr/^[A-Z_]+$/ ] });Transmission-Client-0.0804/t/05-utils.t0000644000175000017500000000141612203634547016214 0ustar olofolof#!perl # ex:ts=4:sw=4:sts=4:et use strict; use lib qw(lib); use Transmission::Utils (); use Test::More; plan tests => 8; my $numeric = 16; my $str = "stopped"; ok(!*from_numeric_status{'CODE'}, "from_numeric_status not imported"); ok(!*to_numeric_status{'CODE'}, "to_numeric_status not imported"); Transmission::Utils->import('from_numeric_status'); ok(*from_numeric_status{'CODE'}, "from_numeric_status imported"); is(from_numeric_status($numeric), $str, "from_numeric_status ok"); is(from_numeric_status(-1), "", "from_numeric_status ok"); Transmission::Utils->import('to_numeric_status'); ok(*to_numeric_status{'CODE'}, "to_numeric_status imported"); is(to_numeric_status($str), $numeric, "to_numeric_status ok"); is(to_numeric_status("foo"), -1, "to_numeric_status ok"); Transmission-Client-0.0804/t/20-real.t0000644000175000017500000000375312203634547016002 0ustar olofolof#!perl # ex:ts=4:sw=4:sts=4:et use strict; use warnings; use lib qw(lib); use Transmission::Client; use Test::More; plan skip_all => "REAL_TEST is not set" unless($ENV{'REAL_TEST'}); plan tests => 24; my $obj = Transmission::Client->new(username => 'testman', password => 'test'); my $id = $ENV{'REAL_TEST'}; is($obj->url, 'http://localhost:9091/transmission/rpc', '->url'); is($obj->_url, 'http://testman:test@localhost:9091/transmission/rpc', '->_url'); isa_ok($obj->session, 'Transmission::Session', '->session'); isa_ok($obj->stats, 'Transmission::Stats', '->stats'); ok($obj->torrents, '->torrents'); like($obj->version || '__undef__', qr{^\d+.\d+}, '->version'); ok(!$obj->add, "Could not add") or diag($obj->error); ok(!$obj->remove, "Could not remove") or diag($obj->error); ok(!$obj->start, "Could not start") or diag($obj->error); ok(!$obj->stop, "Could not stop") or diag($obj->error); ok(!$obj->verify, "Could not verify") or diag($obj->error); SKIP: { is(int(@_ = $obj->read_torrents(eager_read => $id)), 3, "->read_torrents eagerly"); is(int(@_ = $obj->read_torrents(ids => $id)), 1, "->read_torrents with ids") or skip 'fail to read torrent', 11; my $torrent = $obj->torrents->[0]; ok(@{ $torrent->files } > 0, 'torrent has files'); my $file = $torrent->files->[0]; like($file->name, qr{\w}, 'torrent has name'); ok($file->length > 0, 'torrent has size'); is($file->priority, 0, 'torrent has normal priority'); $file->priority(1); $file->wanted(0); ok($torrent->write_priority, 'torrent priority has been written'); ok($torrent->write_wanted, 'torrent wanted has been written'); ok($obj->read_all, "data is refreshed"); $file = $torrent->files->[0]; is($file->priority, 1, 'file has high priority'); is($file->wanted, 0, 'file is not wanted'); $file->priority(0); $file->wanted(1); ok($torrent->write_priority, 'torrent priority has reset'); ok($torrent->write_wanted, 'torrent wanted has reset'); } #print $obj->dump; Transmission-Client-0.0804/t/00-pod.t0000644000175000017500000000021512203634547015625 0ustar olofolof# ex:ts=4:sw=4:sts=4:et use lib qw(lib); use Test::More; eval 'use Test::Pod;1' or plan skip_all => 'Test::Pod required'; all_pod_files_ok();Transmission-Client-0.0804/t/10-types.t0000644000175000017500000000221712203634547016214 0ustar olofolof# ex:ts=4:sw=4:sts=4:et # Tests for helper functions in Transmission::Types use warnings; use strict; use Test::More tests => 11; use Transmission::Types; ok Transmission::Types::_is_num(10), '_is_num(10)'; ok Transmission::Types::_is_num(10.0), '_is_num(10.0)'; ok !Transmission::Types::_is_num("foo"), 'not _is_num("foo")'; ok !Transmission::Types::_is_num("10.0"), 'not _is_num("10.0")'; is Transmission::Types::_coerce_num("10"), 10, 'coerced numeric str "10" should become 10'; is Transmission::Types::_coerce_num("10.1"), 10.1, 'coerced numeric str "10.1" should become 10.1'; is Transmission::Types::_coerce_num("foo"), -1, 'coerced non-numeric str "foo" should become -1'; ok Transmission::Types::_is_num(Transmission::Types::_coerce_num("10")), 'coerced numeric str should become num'; ok Transmission::Types::_is_num(Transmission::Types::_coerce_num(10)), 'coerced integer should still be num'; ok Transmission::Types::_is_num(Transmission::Types::_coerce_num(10.0)), 'coerced double should still be num'; ok Transmission::Types::_is_num(Transmission::Types::_coerce_num("foo")), 'coerced non-numeric str "foo" should become num'; Transmission-Client-0.0804/META.yml0000644000175000017500000000133512420764561015454 0ustar olofolof--- abstract: 'Interface to Transmission' author: - '-2013, Jan Henning Thorsen and contributors' build_requires: ExtUtils::MakeMaker: 6.36 Test::More: 0 configure_requires: ExtUtils::MakeMaker: 6.36 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.06' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Transmission-Client no_index: directory: - inc - t requires: DateTime: 0.5 JSON: '2.02' JSON::Any: 1.2 LWP::UserAgent: 5.8 List::MoreUtils: 0 MIME::Base64: 3 Moose: 0.8 MooseX::Types: 0.2 Sub::Exporter: 0.95 resources: license: http://dev.perl.org/licenses/ version: '0.0804' Transmission-Client-0.0804/Changes0000644000175000017500000000653412420764514015502 0ustar olofolofRevision history for Transmission-Client 0.0804 Sun Oct 19 18:30:59 CEST 2014 - Fix perl precedence warning in Types 0.0803 Mon Sep 16 19:22:46 CEST 2013 - Fix POD issues (NAME section syntax) - Add explicit copyright statements - Add .gitignore to MANIFEST.SKIP - Add AUTHORS file Thanks to Marius Gavrilescu of the Debian Perl team for reporting the above issues. 0.0802 Wed Aug 21 17:49:02 CEST 2013 - Update types of Transmission::Torrent attributes With the stricter type coercions introduced with 0.08, types specified in the transmission rpc spec to be doubles were truncated to integers. This is now fixed. 0.0801 Sat Aug 17 10:53:07 CEST 2013 - Don't use the defined or operator (//). It's only available since perl 5.10.0. Fixes test failures. 0.08 Fri Aug 16 17:28:12 CEST 2013 - Improvements in type coercions for numeric types Numeric types that got encoded in JSON as strings were silently ignored by Transmission. Now we make sure that they are converted to numeric types (SVp_IOK | SVp_NOK), regardless of input. 0.0701 Mon Jul 22 19:31:56 CEST 2013 - Fix build failure introduced in 0.07 - New maintainer: Olof Johansson 0.07 Sat Jul 20 00:40:58 2013 - Fix test failures due to hash randomization (RT #81561) Merge pull request #3 from afresh1/master - Make fields parameter to read_torrents overrideable Merge pull request #5 from olof/topic/override_fields 0.0603 Mon May 7 19:29:53 2012 - Use correct var when adding torrent Reference: https://rt.cpan.org/Ticket/Display.html?id=76859 0.0602 Fri Apr 29 22:18:36 CEST 2011 - Fix RT#67691: rpc() can now handle ids as hashes 0.0601 Wed Apr 20 12:17:43 CEST 2011 - Fix fail to load json, with json-any http://www.cpantesters.org/cpan/report/f1e67256-36b4-11e0-afb0-adca6bb533f3 0.06 Sun Feb 6 18:33:13 CET 2011 - Fix RT62805: location to the rpc-spec is updated: https://trac.transmissionbt.com/browser/trunk/extras/rpc-spec.txt - Fix RT62805: methods given to rpc() can contain both underscores and hyphens. - Adding "autodie" to new() will make the module throw exceptions, instead of silently setting "error". 0.05 Sat May 29 22:27:02 CEST 2010 - Fix RT57970: username() and password() does not work 0.04 Mon Apr 26 22:35:37 CEST 2010 - Fix boolean type was true even when "false" - Fix setting of boolean data in Session attributes - Add Session and Stats attributes can will build its own value. The attributes can also be cleared and rebuilt. 0.03 Mon Apr 26 21:54:28 CEST 2010 - Change read_all() returns fetched data in a hash - Add example script 0.02 Sat Dec 19 21:43:19 2009 +0100 - Fix file->id bug: id is set - Fix file->key bug: File has no "key" - Add torrent->write_wanted() - Add torrnte->write_priority() 0.01 Mon Okt 5 20:43:19 2009 +0200 - can connect to deamon - can retrieve session data/stats - can retrieve torrent data/stats - can retrieve torrent files - can add torrent - can execute actions on a torrent: start/stop/remove/verify Transmission-Client-0.0804/bin/0000755000175000017500000000000012420764562014752 5ustar olofolofTransmission-Client-0.0804/bin/transmission-client.pl0000755000175000017500000000555212215635440021320 0ustar olofolof#!/usr/bin/perl # Copyright 2009-2010, Jan Henning Thorsen # and contributors # # All rights reserved. # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. =head1 NAME transmission-client.pl - Alternative to transmission-remote =head1 SYNOPSIS transmission-client.pl list; transmission-client.pl session; transmission-client.pl session $key $value; transmission-client.pl stats; =head1 DESCRIPTION This is an example application for L =cut use strict; use warnings; use lib qw(lib); use Transmission::Client; my $action = shift @ARGV or _help(); my $tc = Transmission::Client->new; if($action eq 'list') { printf "%3s %-34s %4s %4s %5s %5s\n", 'id', 'name', 'lcrs', 'sdrs', 'rate', 'eta'; print "-" x 79, "\n"; for my $torrent ($tc->read_torrents) { printf "%3i %-34s %4s %4s %5s %5s\n", $torrent->id, substr($torrent->name, 0, 34), _peers($torrent->leechers), _peers($torrent->seeders), _rate($torrent->rate_download), _eta($torrent->eta), ; } } elsif($action eq 'session') { if(my $set = shift @ARGV) { $tc->session->$set(shift @ARGV); $tc->session->${ \"clear_$set" }; printf "%s: %s\n", $set, $tc->session->$set; print $tc->error; } else { my $res = $tc->session->read_all; for my $key (sort keys %$res) { printf "%-30s %s\n", $key, $res->{$key}; } } } elsif($action eq 'stats') { my $res = $tc->session->stats->read_all; for my $key (sort keys %$res) { printf "%-30s %s\n", $key, $res->{$key}; } } else { _help(); } print "\n"; #============================================================================== sub _peers { my $n = shift; if($n < 0) { return 'na'; } elsif($n < 9999) { return $n; } else { return '++'; } } sub _rate { my $kbps = shift; if($kbps < 0) { return '0'; } elsif($kbps < 1000) { return $kbps; } elsif($kbps < 1e6) { return int($kbps / 1e3) . 'k'; } elsif($kbps < 1e6) { return int($kbps / 1e6) . 'M'; } else { return '++'; } } sub _eta { my $sec = shift; if($sec < 0) { return 'inf'; } elsif($sec < 60) { return $sec . "s"; } elsif($sec < 3600) { return int($sec / 6) / 10 . "m"; } elsif($sec < 86400) { return int($sec / 360) / 10 . "h"; } else { return '>1d'; } } sub _help { exec perldoc => -tT => $0; } =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L =head1 AUTHOR Jan Henning Thorsen =cut exit; Transmission-Client-0.0804/lib/0000755000175000017500000000000012420764562014750 5ustar olofolofTransmission-Client-0.0804/lib/Transmission/0000755000175000017500000000000012420764562017441 5ustar olofolofTransmission-Client-0.0804/lib/Transmission/AttributeRole.pm0000644000175000017500000000406012215635367022566 0ustar olofolof# ex:ts=4:sw=4:sts=4:et package Transmission::AttributeRole; # See Transmission::Client for copyright statement. =head1 NAME Transmission::AttributeRole - For Torrent and Client =head1 DESCRIPTION This role is used by L and L. It requires the consuming class to provide the method C. =cut use Moose::Role; =head1 ATTRIBUTES =head2 client $obj = $self->client; Returns a L object. =cut has client => ( is => 'ro', isa => 'Object', handles => { client_error => 'error' }, ); =head2 lazy_write $bool = $self->lazy_write; $self->lazy_write($bool); Will prevent writeable attributes from sending a request to Transmission. L can then later be used to sync data. =cut has lazy_write => ( is => 'rw', isa => 'Bool', default => 0, ); =head2 eager_read $bool = $self->eager_read; Setting this attribute in constructor forces L to be called. This will again populate all (or most) attributes right after the object is constructed (if Transmission answers the request). =cut has eager_read => ( is => 'ro', isa => 'Bool', default => 0, trigger => sub { $_[0]->read_all if($_[1]) }, ); # this method name exists to prove a point - not to be readable... sub _convert { if(ref $_[1] eq 'HASH') { for my $camel (keys %{ $_[1] }) { my $key = $_[2]->($camel); if(ref $_[1]->{$camel} eq 'HASH') { __PACKAGE__->_convert($_[1]->{$camel}, $_[2]); } $_[1]->{$key} = delete $_[1]->{$camel}; } } else { return $_[2]->($_[1]); } } sub _camel2Normal { $_[0]->_convert( $_[1], sub { local $_ = $_[0]; tr/-/_/; s/([A-Z]+)/{ "_" .lc($1) }/ge; return $_; } ); } sub _normal2Camel { $_[0]->_convert( $_[1], sub { local $_ = $_[0]; tr/_/-/; s/_(\w)/{ uc($1) }/ge; # wild guess... return $_; } ); } =head1 LICENSE =head1 AUTHOR See L =cut 1; Transmission-Client-0.0804/lib/Transmission/Utils.pm0000644000175000017500000000172012215635367021101 0ustar olofolof# ex:ts=4:sw=4:sts=4:et package Transmission::Utils; # See Transmission::Client for copyright statement. =head1 NAME Transmission::Utils - Utilies for modules that use Transmission::* =cut use strict; use warnings; use Sub::Exporter -setup => { exports => [qw/ from_numeric_status to_numeric_status /], }; my %numeric_status = qw/ 1 queued 2 checking 4 downloading 8 seeding 16 stopped /; =head1 FUNCTIONS =head2 from_numeric_status $str = from_numeric_status($int); Will translate a numeric status description from Transmission to something readable. =cut sub from_numeric_status { return $numeric_status{$_[0]} || q(); } =head2 to_numeric_status $int = to_numeric_status($str); Will translate a status description to a number used by Transmission. =cut sub to_numeric_status { my %tmp = reverse %numeric_status; return $tmp{$_[0]} || -1; } =head1 LICENSE =head1 AUTHOR See L =cut 1; Transmission-Client-0.0804/lib/Transmission/Stats.pm0000644000175000017500000000462312215635367021104 0ustar olofolof# ex:ts=4:sw=4:sts=4:et package Transmission::Stats; # See Transmission::Client for copyright statement. =head1 NAME Transmission::Stats - Transmission session statistics =head1 DESCRIPTION See "4.2 Sesion statistics" from L =cut use Moose; use Transmission::Types ':all'; with 'Transmission::AttributeRole'; =head1 ATTRIBUTES =head2 active_torrent_count $num = $self->active_torrent_count; =head2 download_speed $num = $self->download_speed; =head2 paused_torrent_count $num = $self->paused_torrent_count; =head2 torrent_count $num = $self->torrent_count; =head2 upload_speed $num = $self->upload_speed; =cut BEGIN { my %both = ( activeTorrentCount => number, downloadSpeed => number, pausedTorrentCount => number, torrentCount => number, uploadSpeed => number, ); for my $camel (keys %both) { (my $name = $camel) =~ s/([A-Z]+)/{ "_" .lc($1) }/ge; __PACKAGE__->meta->add_attribute($name => ( is => 'ro', isa => $both{$camel}, coerce => 1, writer => "_set_$name", clearer => "clear_$name", lazy => 1, default => sub { my $self = shift; my $val = delete $self->_tmp_store->{$name}; if(defined $val) { return $val; } else { $self->_clear_tmp_store; return delete $self->_tmp_store->{$name}; } }, )); } __PACKAGE__->meta->add_attribute(_tmp_store => ( is => 'ro', isa => 'HashRef', lazy => 1, builder => 'read_all', clearer => '_clear_tmp_store', )); __PACKAGE__->meta->add_method(read_all => sub { my $self = shift; my $lazy = $self->lazy_write; my(%res, $rpc); $rpc = $self->client->rpc('session-stats') or return; $self->lazy_write(1); for my $camel (keys %both) { my $name = __PACKAGE__->_camel2Normal($camel); my $writer = "_set_$name"; $res{$name} = $rpc->{$camel}; $self->$writer($rpc->{$camel}); } $self->lazy_write($lazy); return \%res; }); } =head1 LICENSE =head1 AUTHOR See L =cut 1; Transmission-Client-0.0804/lib/Transmission/Torrent/0000755000175000017500000000000012420764562021076 5ustar olofolofTransmission-Client-0.0804/lib/Transmission/Torrent/File.pm0000644000175000017500000000354012215637025022310 0ustar olofolof# ex:ts=4:sw=4:sts=4:et package Transmission::Torrent::File; # See Transmission::Client for copyright statement. =head1 NAME Transmission::Torrent::File - file within a Transmission torrent =cut use Moose; use Transmission::Types ':all'; with 'Transmission::AttributeRole'; =head1 ATTRIBUTES =head2 id $int = $self->id; This file index in the files list. =cut has id => ( is => 'ro', isa => 'Int', default => -1, ); =head2 length $num = $self->length; File size in bytes. =head2 name $str = $self->name; =head2 bytes_completed $num = $self->bytes_completed; Bytes downloaded. =head2 wanted $bool = $self->wanted; Flag which decides if this file will be downloaded or not. =cut has wanted => ( is => 'rw', isa => boolean, coerce => 1, default => 1, ); =head2 priority $int = $self->priority; Low, Normal or High, with the respectable values: -1, 0 and 1. =cut has priority => ( is => 'rw', isa => number, coerce => 1, default => 0, ); { my %read = ( key => string, length => number, name => string, bytesCompleted => number, ); for my $camel (keys %read) { my $name = __PACKAGE__->_camel2Normal($camel); has $name => ( is => 'ro', isa => $read{$camel}, coerce => 1, writer => "_set_$name", ); } } =head1 METHODS =head2 BUILDARGS $hash_ref = $class->BUILDARGS(\%args); Convert keys in C<%args> from "CamelCase" to "camel_case". =cut sub BUILDARGS { my $self = shift; my $args = $self->SUPER::BUILDARGS(@_); for my $camel (keys %$args) { my $key = __PACKAGE__->_camel2Normal($camel); $args->{$key} = delete $args->{$camel}; } return $args; } =head1 LICENSE =head1 AUTHOR See L =cut 1; Transmission-Client-0.0804/lib/Transmission/Torrent.pm0000644000175000017500000003332512215637014021433 0ustar olofolof# ex:ts=4:sw=4:sts=4:et package Transmission::Torrent; # See Transmission::Client for copyright statement. =head1 NAME Transmission::Torrent - Transmission torrent object =head1 DESCRIPTION See "3.2 Torrent Mutators" and "3.3 Torrent accessors" from L This class handles data related to a torrent known to Transmission. =head1 SEE ALSO L =cut use Moose; use List::MoreUtils qw(uniq); use Transmission::Torrent::File; use Transmission::Types ':all'; BEGIN { with 'Transmission::AttributeRole'; } =head1 ATTRIBUTES =head2 id $id = $self->id; Returns the id that identifies this torrent in transmission. =cut has id => ( is => 'ro', isa => 'Int', writer => '_set_id', required => 1, ); =head2 bandwidth_priority $self->bandwidth_priority($num); This torrent's bandwidth. =head2 download_limit $self->download_limit($num); Maximum download speed (in K/s). =head2 download_limited $self->download_limited($bool); True if "downloadLimit" is honored. =head2 honors_session_limits $self->honors_session_limits($bool); True if session upload limits are honored. =head2 location $self->location($str); New location of the torrent's content =head2 peer_limit $self->peer_limit($num); Maximum number of peers =head2 seed_ratio_limit $self->seed_ratio_limit($num); Session seeding ratio. =head2 seed_ratio_mode $self->seed_ratio_mode($num); Which ratio to use. See tr_ratiolimit. =head2 upload_limit $self->upload_limit($num); Maximum upload speed (in K/s) =head2 upload_limited $self->upload_limited($bool); True if "upload_limit" is honored =head2 activity_date $num = $self->activity_date; =head2 added_date $num = $self->added_date; =head2 bandwidth_priority $num = $self->bandwidth_priority; =head2 comment $str = $self->comment; =head2 corrupt_ever $num = $self->corrupt_ever; =head2 creator $str = $self->creator; =head2 date_created $num = $self->date_created; =head2 desired_available $num = $self->desired_available; =head2 done_date $num = $self->done_date; =head2 download_dir $str = $self->download_dir; =head2 downloaded_ever $num = $self->downloaded_ever; =head2 downloaders $num = $self->downloaders; =head2 download_limit $num = $self->download_limit; =head2 download_limited $bool = $self->download_limited; =head2 error $num = $self->error; =head2 error_string $str = $self->error_string; =head2 eta $num = $self->eta; =head2 hash_str $str = $self->hash_string; =head2 have_unchecked $num = $self->have_unchecked; =head2 have_valid $num = $self->have_valid; =head2 honors_session_limits $bool = $self->honors_session_limits; =head2 is_private $bool = $self->is_private; =head2 leechers $num = $self->leechers; =head2 left_until_done $num = $self->left_until_done; =head2 manual_announce_time $num = $self->manual_announce_time; =head2 max_connected_peers $num = $self->max_connected_peers; =head2 name $str = $self->name; =head2 peer $num = $self->peer; =head2 peers_connected $num = $self->peers_connected; =head2 peers_getting_from_us $num = $self->peers_getting_from_us; =head2 peers_known $num = $self->peers_known; =head2 peers_sending_to_us $num = $self->peers_sending_to_us; =head2 percent_done $num = $self->percent_done; =head2 pieces $str = $self->pieces; =head2 piece_count $num = $self->piece_count; =head2 piece_size $num = $self->piece_size; =head2 rate_download $num = $self->rate_download; =head2 rate_upload $num = $self->rate_upload; =head2 recheck_progress $num = $self->recheck_progress; =head2 seeders $num = $self->seeders; =head2 seed_ratio_limit $num = $self->seed_ratio_limit; =head2 seed_ratio_mode $num = $self->seed_ratio_mode; =head2 size_when_done $num = $self->size_when_done; =head2 start_date $num = $self->start_date; =head2 status $str = $self->status; =head2 swarm_speed $num = $self->swarm_speed; =head2 times_completed $num = $self->times_completed; =head2 total_size $num = $self->total_size; =head2 torrent_file $str = $self->torrent_file; =head2 uploaded_ever $num = $self->uploaded_ever; =head2 upload_limit $num = $self->upload_limit; =head2 upload_limited $bool = $self->upload_limited; =head2 upload_ratio $num = $self->upload_ratio; =head2 webseeds_sending_to_us $num = $self->webseeds_sending_to_us; =cut BEGIN { my $create_setter = sub { my $camel = $_[0]; return sub { return if($_[0]->lazy_write); $_[0]->client->rpc('torrent-set' => ids => [ $_[0]->id ], $camel => $_[1], ); }; }; my $create_getter = sub { my $camel = $_[0]; return sub { my $data = $_[0]->client->rpc('torrent-get' => ids => [ $_[0]->id ], fields => [ $camel ], ); return unless($data); return $data->{'torrents'}[0]{$camel}; }; }; my %SET = ( #'files-wanted' => array, #'files-unwanted' => array, 'location' => string, 'peer-limit' => number, #'priority-high' => array, #'priority-low' => array, #'priority-normal' => array, ); our %BOTH = ( # meant for internal usage bandwidthPriority => number, downloadLimit => number, downloadLimited => boolean, honorsSessionLimits => boolean, seedRatioLimit => double, seedRatioMode => number, uploadLimit => number, uploadLimited => boolean, ); our %READ = ( # meant for internal usage activityDate => number, addedDate => number, comment => string, corruptEver => number, creator => string, dateCreated => number, desiredAvailable => number, doneDate => number, downloadDir => string, downloadedEver => number, downloaders => number, error => number, errorString => string, eta => number, hashString => string, haveUnchecked => number, haveValid => number, isPrivate => boolean, leechers => number, leftUntilDone => number, manualAnnounceTime => number, maxConnectedPeers => number, name => string, peersConnected => number, peersGettingFromUs => number, peersKnown => number, peersSendingToUs => number, percentDone => double, pieceCount => number, pieceSize => number, rateDownload => number, rateUpload => number, recheckProgress => double, seeders => number, sizeWhenDone => number, startDate => number, status => string, swarmSpeed => number, timesCompleted => number, totalSize => number, torrentFile => string, uploadedEver => number, uploadRatio => double, webseedsSendingToUs => number, ); #peers => array, #peersFrom => object, #pieces => string, #priorities => array, #trackers => array, #trackerStats => array, #wanted => array, #webseeds => array, for my $camel (keys %SET) { my $name = __PACKAGE__->_camel2Normal($camel); my $setter = $create_setter->($camel); __PACKAGE__->meta->add_method("write_$name" => $setter); has $name => ( is => 'rw', isa => $SET{$camel}, coerce => 1, trigger => $setter, ); } for my $camel (keys %BOTH) { my $name = __PACKAGE__->_camel2Normal($camel); my $setter = $create_setter->($camel); my $getter = $create_getter->($camel); __PACKAGE__->meta->add_method("write_$name" => $setter); has $name => ( is => 'rw', isa => $BOTH{$camel}, coerce => 1, lazy => 1, trigger => $setter, default => $getter, ); } for my $camel (keys %READ) { my $name = __PACKAGE__->_camel2Normal($camel); my $getter = $create_getter->($camel); has $name => ( is => 'ro', isa => $READ{$camel}, coerce => 1, writer => "_set_$name", lazy => 1, default => $getter, ); } __PACKAGE__->meta->add_method(read => sub { my $self = shift; my @fields = uniq(@_, 'id'); # id should always be requested my $lazy = $self->lazy_write; my $data; $data = $self->client->rpc('torrent-get' => ids => [ $self->id ], fields => [ @fields ], ) or return; $data = $data->{'torrents'}[0] or return; # prevent from fireing off trigger in attributes $self->lazy_write(1); for my $camel (keys %$data) { my $name = __PACKAGE__->_camel2Normal($camel); my $writer = $READ{$camel} ? "_set_$name" : $name; $self->$writer($data->{$camel}); } # reset lazy_write $self->lazy_write($lazy); return 1; }); __PACKAGE__->meta->add_method(read_all => sub { my $self = shift; return $self->read(keys %BOTH, keys %READ); }); $READ{'id'} = 'Int'; # this is required to be read } =head2 files $array_ref = $self->files; $self->clear_files; Returns an array of Ls. =cut has files => ( is => 'ro', isa => 'ArrayRef', lazy_build => 1, ); sub _build_files { my $self = shift; my $files = []; my $stats = []; my $id = 0; my $data; $data = $self->client->rpc('torrent-get' => ids => [ $self->id ], fields => [ qw/ files fileStats / ], ); return [] unless($data); $files = $data->{'torrents'}[0]{'files'}; $stats = $data->{'torrents'}[0]{'fileStats'}; # this has to be true: @$files == @$stats while(@$stats) { my $stats = shift @$stats or last; my $file = shift @$files; push @$files, Transmission::Torrent::File->new(id => $id, %$stats, %$file); $id++; } return $files; } =head1 METHODS =head2 BUILDARGS $hash_ref = $self->BUILDARGS(\%args); Convert keys in C<%args> from "CamelCase" to "camel_case". =cut sub BUILDARGS { my $self = shift; my $args = $self->SUPER::BUILDARGS(@_); $self->_camel2Normal($args); return $args; } =head2 read $bool = $self->read('id', 'name', 'eta'); This method will refresh all requested attributes in one RPC request, while calling one and one attribute, results in one-and-one request. =head2 read_all $bool = $self->read_all; Similar to L, but requests all attributes. =head2 start See L. =head2 stop See L. =head2 verify See L. =cut { for my $name (qw/ start stop verify /) { __PACKAGE__->meta->add_method($name => sub { $_[0]->client->$name(ids => $_[0]->id); }); } } =head2 move $bool = $self->move($path); Will move the torrent content to C<$path>. =cut sub move { my $self = shift; my $path = shift; unless($path) { $self->client_error("Required argument 'path' is missing"); return; } return $self->client->move( ids => [$self->id], location => $path, move => 1, ); } =head2 write_wanted $bool = $self->write_wanted; Will write "wanted" information from L to transmission. =cut sub write_wanted { my $self = shift; my %wanted = ( wanted => [], unwanted => [] ); my $ok; for my $file (@{ $self->files }) { push @{ $wanted{ $file->wanted ? 'wanted' : 'unwanted' } }, $file->id; } for my $key (qw/wanted unwanted/) { # Transmission interpret an empty list to mean all files next unless @{$wanted{$key}}; $self->client->rpc('torrent-set' => ids => [ $self->id ], "files-$key" => $wanted{$key} ) or return; } return 1; } =head2 write_priority $bool = $self->write_priority; Will write "priorty" information from L to transmission. =cut sub write_priority { my $self = shift; my %priority = ( low => [], normal => [], high => [] ); my %map = ( -1 => 'low', 0 => 'normal', 1 => 'high' ); for my $file (@{ $self->files }) { my $key = $map{ $file->priority } || 'normal'; push @{ $priority{$key} }, $file->id; } for my $key (qw/low normal high/) { $self->client->rpc('torrent-set' => ids => [ $self->id ], "priority-$key" => $priority{$key} ) or return; } return 1; } =head1 LICENSE =head1 AUTHOR See L. =cut 1; Transmission-Client-0.0804/lib/Transmission/Session.pm0000644000175000017500000001353012215635367021426 0ustar olofolof# ex:ts=4:sw=4:sts=4:et package Transmission::Session; # See Transmission::Client for copyright statement. =head1 NAME Transmission::Session - Transmission session =head1 DESCRIPTION See "4 Session requests" from L This class holds data, regarding the Transmission session. =cut use Moose; use Transmission::Types ':all'; use Transmission::Stats; BEGIN { with 'Transmission::AttributeRole'; } =head1 ATTRIBUTES =head2 stats $stats_obj = $self->stats; Returns a L object. =cut has stats => ( is => 'ro', isa => 'Object', lazy => 1, default => sub { Transmission::Stats->new(client => $_[0]->client); } ); =head2 alt_speed_down $number = $self->alt_speed_down max global download speed (in K/s) =head2 alt_speed_enabled $boolean = $self->alt_speed_enabled true means use the alt speeds =head2 alt_speed_time_begin $number = $self->alt_speed_time_begin when to turn on alt speeds (units: minutes after midnight) =head2 alt_speed_time_enabled $boolean = $self->alt_speed_time_enabled true means the scheduled on/off times are used =head2 alt_speed_time_end $number = $self->alt_speed_time_end when to turn off alt speeds (units: same) =head2 alt_speed_time_day $number = $self->alt_speed_time_day what day(s) to turn on alt speeds (look at tr_sched_day) =head2 alt_speed_up $number = $self->alt_speed_up max global upload speed (in K/s) =head2 blocklist_enabled $boolean = $self->blocklist_enabled true means enabled =head2 dht_enabled $boolean = $self->dht_enabled true means allow dht in public torrents =head2 encryption $string = $self->encryption "required", "preferred", "tolerated" =head2 download_dir $string = $self->download_dir default path to download torrents =head2 peer_limit_global $number = $self->peer_limit_global maximum global number of peers =head2 peer_limit_per_torrent $number = $self->peer_limit_per_torrent maximum global number of peers =head2 pex_enabled $boolean = $self->pex_enabled true means allow pex in public torrents =head2 peer_port $number = $self->peer_port port number =head2 peer_port_random_on_start $boolean = $self->peer_port_random_on_start true means pick a random peer port on launch =head2 port_forwarding_enabled $boolean = $self->port_forwarding_enabled true means enabled =head2 seedRatioLimit $double = $self->seedRatioLimit the default seed ratio for torrents to use =head2 seedRatioLimited $boolean = $self->seedRatioLimited true if seedRatioLimit is honored by default =head2 speed_limit_down $number = $self->speed_limit_down max global download speed (in K/s) =head2 speed_limit_down_enabled $boolean = $self->speed_limit_down_enabled true means enabled =head2 speed_limit_up $number = $self->speed_limit_up max global upload speed (in K/s) =head2 speed_limit_up_enabled $boolean = $self->speed_limit_up_enabled true means enabled =cut BEGIN { my %both = ( 'alt-speed-down' => number, 'alt-speed-enabled' => boolean, 'alt-speed-time-begin' => number, 'alt-speed-time-enabled' => boolean, 'alt-speed-time-end' => number, 'alt-speed-time-day' => number, 'alt-speed-up' => number, 'blocklist-enabled' => boolean, 'dht-enabled' => boolean, 'encryption' => string, 'download-dir' => string, 'peer-limit-global' => number, 'peer-limit-per-torrent' => number, 'pex-enabled' => boolean, 'peer-port' => number, 'peer-port-random-on-start' => boolean, 'port-forwarding-enabled' => boolean, 'seedRatioLimit' => number, 'seedRatioLimited' => boolean, 'speed-limit-down' => number, 'speed-limit-down-enabled' => boolean, 'speed-limit-up' => number, 'speed-limit-up-enabled' => boolean, ); for my $camel (keys %both) { my $name = __PACKAGE__->_camel2Normal($camel); __PACKAGE__->meta->add_attribute($name => ( is => 'rw', isa => $both{$camel}, coerce => 1, lazy => 1, clearer => "clear_$name", trigger => sub { return if($_[0]->lazy_write); $_[0]->client->rpc('session-set' => $camel => ($both{$camel} eq boolean and $_[1]) ? 'true' : ($both{$camel} eq boolean and !$_[1]) ? 'false' : $_[1] ); }, default => sub { my $self = shift; my $val = delete $self->_tmp_store->{$name}; if(defined $val) { return $val; } else { $self->_clear_tmp_store; return delete $self->_tmp_store->{$name}; } }, )); } __PACKAGE__->meta->add_attribute(_tmp_store => ( is => 'ro', isa => 'HashRef', lazy => 1, builder => 'read_all', clearer => '_clear_tmp_store', )); __PACKAGE__->meta->add_method(read_all => sub { my $self = shift; my $lazy = $self->lazy_write; my($rpc, %res); $rpc = $self->client->rpc('session-get') or return; $self->lazy_write(1); for my $camel (keys %both) { my $name = __PACKAGE__->_camel2Normal($camel); $res{$name} = $rpc->{$camel}; $self->$name($rpc->{$camel}); } $self->lazy_write($lazy); return \%res; }); } =head1 LICENSE =head1 AUTHOR See L =cut 1; Transmission-Client-0.0804/lib/Transmission/Types.pm0000644000175000017500000000350212420762670021101 0ustar olofolof# ex:ts=4:sw=4:sts=4:et package Transmission::Types; # See Transmission::Client for copyright statement. =head1 NAME Transmission::Types - Moose types for Transmission =head1 DESCRIPTION The types below is pretty much what you would expect them to be, execpt for some (maybe weird?) default values - that is for coercion from "Any". The type names correspond to types used in the Transmission RPC specification. =head1 TYPES =head2 number =head2 double =head2 string =head2 boolean =head2 array =cut use MooseX::Types -declare => [qw/number double string boolean array/]; use MooseX::Types::Moose ':all'; use B; # If Perl thinks a value is a string, JSON will encode it as such. But # Transmission is picky about how parameters are encoded in the JSON # request, so we make sure Perl knows how to store numeric types. sub _coerce_num { local $_ = shift; return -1 unless defined $_ and /^[0-9]+(?:\.[0-9]+)?$/; return 0+$_; } sub _is_num { my $sv = shift; my $flags = B::svref_2object(\$sv)->FLAGS; # Make sure perl internally thinks of $sv as an integer # or numeric value. In earlier releases I also made sure that # it's not a string ($flags & B::SVp_POK), but POK and # (NOK|IOK) seem to be mutually exclusive. return $flags & (B::SVp_NOK | B::SVp_IOK); } subtype number, as Num, where { _is_num($_) and $_ == int $_}; coerce number, from Any, via { int _coerce_num($_) }; subtype double, as Num, where { _is_num($_) }; coerce double, from Any, via { _coerce_num($_) }; subtype string, as Str; coerce string, from Any, via { defined $_ ? "$_" : "__UNDEF__" }; type boolean, where { defined $_ and $_ =~ /^(1|0)$/ }; coerce boolean, from Object, via { int $_ }; subtype array, as ArrayRef; coerce array, from Any, via { [] }; =head1 LICENSE =head1 NAME See L =cut 1; Transmission-Client-0.0804/lib/Transmission/Client.pm0000644000175000017500000003325712420764462021226 0ustar olofolof# ex:ts=4:sw=4:sts=4:et package Transmission::Client; # Copyright 2009-2013, Jan Henning Thorsen # and contributors # # All rights reserved. # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. =head1 NAME Transmission::Client - Interface to Transmission =head1 VERSION 0.0803 =head1 DESCRIPTION L is the main module in a collection of modules to communicate with Transmission. Transmission is: Transmission is a cross-platform BitTorrent client that is: * Easy * Lean * Native * Powerful * Free If you want to communicate with "transmission-daemon", this is a module which can help you with that. The documentation is half copy/paste from the Transmission RPC spec: L This module differs from L in (at least) two ways: This one use L and it won't die. The latter is especially annoying in the constructor. =head1 SYNOPSIS use Transmission::Client; my $client = Transmission::Client->new; my $torrent_id = 2; my $data = base64_encoded_data(); $client->add(metainfo => $data) or confess $client->error; $client->remove($torrent_id) or confess $client->error; for my $torrent (@{ $client->torrents }) { print $torrent->name, "\n"; for my $file (@{ $torrent->files }) { print "> ", $file->name, "\n"; } } print $client->session->download_dir, "\n"; =head1 FAULT HANDLING In C<0.06> L can be constructed with "autodie" set to true, to make this object confess instead of just setting L. Example: my $client = Transmission::Client->new(autodie => 1); eval { $self->add(filename => 'foo.torrent'); } or do { # add() failed... }; =head1 SEE ALSO L L L L =cut use Moose; use DateTime; use DateTime::Duration; use JSON::Any; use LWP::UserAgent; use MIME::Base64; use Transmission::Torrent; use Transmission::Session; use constant RPC_DEBUG => $ENV{'TC_RPC_DEBUG'}; our $VERSION = '0.0804'; our $SESSION_ID_HEADER_NAME = 'X-Transmission-Session-Id'; my $JSON = JSON::Any->new; with 'Transmission::AttributeRole'; =head1 ATTRIBUTES =head2 url $str = $self->url; Returns an URL to where the Transmission rpc api is. Default value is "http://localhost:9091/transmission/rpc"; =cut has url => ( is => 'ro', isa => 'Str', default => 'http://localhost:9091/transmission/rpc', ); # this is subject for change! has _url => ( is => 'ro', isa => 'Str', lazy_build => 1, ); sub _build__url { my $self = shift; my $url = $self->url; if($self->username or $self->password) { my $auth = join ':', $self->username, $self->password; $url =~ s,://,://$auth@,; } return $url; } =head2 error $str = $self->error; Returns the last error known to the object. All methods can return empty list in addition to what specified. Check this attribute if so happens. Like L? Create your object with C set to true and this module will throw exceptions in addition to setting this variable. =cut has error => ( is => 'rw', isa => 'Str', default => '', clearer => '_clear_error', trigger => sub { $_[0]->_autodie and confess $_[1] }, ); has _autodie => ( is => 'ro', init_arg => 'autodie', isa => 'Bool', default => 0, ); =head2 username $str = $self->username; Used to authenticate against Transmission. =cut has username => ( is => 'ro', isa => 'Str', default => '', ); =head2 password $str = $self->password; Used to authenticate against Transmission. =cut has password => ( is => 'ro', isa => 'Str', default => '', ); =head2 timeout $int = $self->timeout; Number of seconds to wait for RPC response. =cut has _ua => ( is => 'rw', isa => 'LWP::UserAgent', lazy => 1, handles => [qw/timeout/], default => sub { LWP::UserAgent->new( agent => 'Transmission-Client' ); }, ); =head2 session $session_obj = $self->session; $stats_obj = $self->stats; Returns an instance of L. C is a proxy method on L. =cut has session => ( is => 'ro', lazy => 1, predicate => 'has_session', handles => [qw/stats/], default => sub { Transmission::Session->new( client => $_[0] ); }, ); =head2 torrents $array_ref = $self->torrents; $self->clear_torrents; Returns an array-ref of L objects. Default value is a full list of all known torrents, with as little data as possible read from Transmission. This means that each request on a attribute on an object will require a new request to Transmission. See L for more information. =cut has torrents => ( is => 'rw', traits => ['Array'], lazy => 1, clearer => "clear_torrents", builder => "read_torrents", predicate => 'has_torrents', handles => { torrent_list => 'elements', }, ); =head2 version $str = $self->version; Get Transmission version. =cut has version => ( is => 'ro', isa => 'Str', lazy_build => 1, ); sub _build_version { my $self = shift; if(my $data = $self->rpc('session-get')) { return $data->{'version'} || q(); } return q(); } =head2 session_id $self->session_id($str); $str = $self->session_id; The session ID used to communicate with Transmission. =cut has session_id => ( is => 'rw', isa => 'Str', default => '', trigger => sub { $_[0]->_ua->default_header($SESSION_ID_HEADER_NAME => $_[1]); }, ); =head1 METHODS =head2 add $bool = $self->add(%args); key | value type & description -----------------+------------------------------------------------- download_dir | string path to download the torrent to filename | string filename or URL of the .torrent file metainfo | string torrent content paused | boolean if true, don't start the torrent peer_limit | number maximum number of peers Either "filename" or "metainfo" MUST be included. All other arguments are optional. See "3.4 Adding a torrent" from L =cut sub add { my $self = shift; my %args = @_; if($args{'filename'} and $args{'metainfo'}) { $self->error("Filename and metainfo argument crash"); return; } elsif($args{'filename'}) { return $self->rpc('torrent-add', %args); } elsif($args{'metainfo'}) { $args{'metainfo'} = encode_base64($args{'metainfo'}); return $self->rpc('torrent-add', %args); } else { $self->error("Need either filename or metainfo argument"); return; } } =head2 remove $bool = $self->remove(%args); key | value type & description -------------------+------------------------------------------------- ids | array torrent list, as described in 3.1 delete_local_data | boolean delete local data. (default: false) C can also be the string "all". C is required. See "3.4 Removing a torrent" from L =cut sub remove { my $self = shift; if($self->_do_ids_action('torrent-remove' => @_)) { $self->clear_torrents; # torrent list might be out of sync return 1; } else { return 0; } } =head2 move $bool = $self->move(%args); string | value type & description ------------+------------------------------------------------- ids | array torrent list, as described in 3.1 location | string the new torrent location move | boolean if true, move from previous location. | otherwise, search "location" for files C can also be the string "all". C and C is required. See "3.5 moving a torrent" from L =cut sub move { my $self = shift; my %args = @_; if(!defined $args{'location'}) { $self->error("location argument is required"); return; } return $self->_do_ids_action('torrent-set-location' => %args); } =head2 start $bool = $self->start($ids); Will start one or more torrents. C<$ids> can be a single int, an array of ints or the string "all". =head2 stop $bool = $self->stop($ids); Will stop one or more torrents. C<$ids> can be a single int, an array of ints or the string "all". =head2 verify $bool = $self->stop($ids); Will verify one or more torrents. C<$ids> can be a single int, an array of ints or the string "all". =cut sub start { return shift->_do_ids_action('torrent-start' => @_); } sub stop { return shift->_do_ids_action('torrent-stop' => @_); } sub verify { return shift->_do_ids_action('torrent-verify' => @_); } sub _do_ids_action { my $self = shift; my $method = shift; my %args = @_ == 1 ? (ids => $_[0]) : @_; my $ids; unless(defined $args{'ids'}) { $self->error('ids is required as argument'); return; } unless(ref $args{'ids'} eq 'ARRAY') { if($args{'ids'} eq 'all') { delete $args{'ids'}; } else { $args{'ids'} = [$args{'ids'}]; } } return $self->rpc($method, %args) ? 1 : 0; } =head2 read_torrents @list = $self->read_torrents(%args); $array_ref = $self->read_torrents(%args); key | value type & description ------------+------------------------------------------------- ids | array torrent list, as described in 3.1 | this is optional lazy_read | will create objects with as little data as possible. =over 4 =item List context Returns a list of L objects and sets the L attribute. =item Scalar context Returns an array-ref of L. =back =cut sub read_torrents { my $self = shift; my %args = @_ == 1 ? (ids => $_[0]) : @_; my $list; # set fields... if(exists $args{'fields'}) { # ... based on user input # We should always request id push @{$args{'fields'}}, 'id' unless grep {'id' eq $_} @{$args{'fields'}}; } elsif($args{'lazy_read'}) { # ... as few fields as possible $args{'fields'} = ['id']; } else { # ... all fields $args{'fields'} = [ keys %Transmission::Torrent::READ, keys %Transmission::Torrent::BOTH, ]; } # set ids if($args{'ids'}) { if($args{'ids'} eq 'all') { delete $args{'ids'}; } elsif(ref $args{'ids'} eq "") { $args{'ids'} = [ $args{'ids'} ]; } } if(my $data = $self->rpc('torrent-get' => %args)) { $list = $data->{'torrents'}; } else { $list = []; } for my $torrent (@$list) { $torrent = Transmission::Torrent->new( client => $self, id => $torrent->{'id'}, %$torrent, ); } if(wantarray) { $self->torrents($list); return @$list; } else { return $list; } } =head2 rpc $any = $self->rpc($method, %args); Communicate with backend. This methods is meant for internal use. =cut sub rpc { my $self = shift; my $method = shift or return; my %args = @_; my $nested = delete $args{'_nested'}; # internal flag my($tag, $res, $post); $method = $self->_normal2Camel($method); # The keys need to be dashes as well # _normal2Camel modifies a hashref in places $self->_normal2Camel( \%args ); # make sure ids are numeric if(ref $args{'ids'} eq 'ARRAY') { for my $id (@{ $args{'ids'} }) { # Need to convert string integer to "real" integer # FLAGS = (IOK,POK,pIOK,pPOK) # IV = 42 # ...to... # FLAGS = (PADTMP,IOK,pIOK) # IV = 42 $id += 0 if($id =~ /^\d+$/); } } $tag = int rand 2*16 - 1; $post = $JSON->encode({ method => $method, tag => $tag, arguments => \%args, }); $res = $self->_ua->post($self->_url, Content => $post); if(RPC_DEBUG) { print "post: $post\n"; print "status_line: ", $res->status_line, "\n"; } unless($res->is_success) { if($res->code == 409 and !$nested) { $self->session_id($res->header($SESSION_ID_HEADER_NAME)); return $self->rpc($method => %args, _nested => 1); } else { $self->error($res->status_line); return; } } $res = $JSON->decode($res->content); unless($res->{'tag'} == $tag) { $self->error("Tag mismatch"); return; } unless($res->{'result'} eq 'success') { $self->error($res->{'result'}); return; } $self->_clear_error; return $res->{'arguments'}; } =head2 read_all 1 == $self->read_all; This method will try to populate ALL torrent, session and stats information, using three requests. =cut sub read_all { my $self = shift; $self->session->read_all; $self->stats->read_all; () = $self->read_torrents; return 1; } =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 COPYRIGHT AND AUTHORS Copyright 2009-2013, Jan Henning Thorsen and contributors Current maintainer: Olof Johansson - C =head2 CONTRIBUTORS =over =item Andrew Fresh =back =cut no MIME::Base64; no Moose; 1; Transmission-Client-0.0804/README0000644000175000017500000001501312215637427015063 0ustar olofolofNAME Transmission::Client - Interface to Transmission VERSION 0.0803 DESCRIPTION Transmission::Client is the main module in a collection of modules to communicate with Transmission. Transmission is: Transmission is a cross-platform BitTorrent client that is: * Easy * Lean * Native * Powerful * Free If you want to communicate with "transmission-daemon", this is a module which can help you with that. The documentation is half copy/paste from the Transmission RPC spec: This module differs from P2P::Transmission in (at least) two ways: This one use Moose and it won't die. The latter is especially annoying in the constructor. SYNOPSIS use Transmission::Client; my $client = Transmission::Client->new; my $torrent_id = 2; my $data = base64_encoded_data(); $client->add(metainfo => $data) or confess $client->error; $client->remove($torrent_id) or confess $client->error; for my $torrent (@{ $client->torrents }) { print $torrent->name, "\n"; for my $file (@{ $torrent->files }) { print "> ", $file->name, "\n"; } } print $client->session->download_dir, "\n"; FAULT HANDLING In 0.06 Transmission::Client can be constructed with "autodie" set to true, to make this object confess instead of just setting "error". Example: my $client = Transmission::Client->new(autodie => 1); eval { $self->add(filename => 'foo.torrent'); } or do { # add() failed... }; SEE ALSO Transmission::AttributeRole Transmission::Session Transmission::Torrent Transmission::Utils ATTRIBUTES url $str = $self->url; Returns an URL to where the Transmission rpc api is. Default value is "http://localhost:9091/transmission/rpc"; error $str = $self->error; Returns the last error known to the object. All methods can return empty list in addition to what specified. Check this attribute if so happens. Like "autodie"? Create your object with "autodie" set to true and this module will throw exceptions in addition to setting this variable. username $str = $self->username; Used to authenticate against Transmission. password $str = $self->password; Used to authenticate against Transmission. timeout $int = $self->timeout; Number of seconds to wait for RPC response. session $session_obj = $self->session; $stats_obj = $self->stats; Returns an instance of Transmission::Session. "stats()" is a proxy method on "session". torrents $array_ref = $self->torrents; $self->clear_torrents; Returns an array-ref of Transmission::Torrent objects. Default value is a full list of all known torrents, with as little data as possible read from Transmission. This means that each request on a attribute on an object will require a new request to Transmission. See "read_torrents" for more information. version $str = $self->version; Get Transmission version. session_id $self->session_id($str); $str = $self->session_id; The session ID used to communicate with Transmission. METHODS add $bool = $self->add(%args); key | value type & description -----------------+------------------------------------------------- download_dir | string path to download the torrent to filename | string filename or URL of the .torrent file metainfo | string torrent content paused | boolean if true, don't start the torrent peer_limit | number maximum number of peers Either "filename" or "metainfo" MUST be included. All other arguments are optional. See "3.4 Adding a torrent" from remove $bool = $self->remove(%args); key | value type & description -------------------+------------------------------------------------- ids | array torrent list, as described in 3.1 delete_local_data | boolean delete local data. (default: false) "ids" can also be the string "all". "ids" is required. See "3.4 Removing a torrent" from move $bool = $self->move(%args); string | value type & description ------------+------------------------------------------------- ids | array torrent list, as described in 3.1 location | string the new torrent location move | boolean if true, move from previous location. | otherwise, search "location" for files "ids" can also be the string "all". "ids" and "location" is required. See "3.5 moving a torrent" from start $bool = $self->start($ids); Will start one or more torrents. $ids can be a single int, an array of ints or the string "all". stop $bool = $self->stop($ids); Will stop one or more torrents. $ids can be a single int, an array of ints or the string "all". verify $bool = $self->stop($ids); Will verify one or more torrents. $ids can be a single int, an array of ints or the string "all". read_torrents @list = $self->read_torrents(%args); $array_ref = $self->read_torrents(%args); key | value type & description ------------+------------------------------------------------- ids | array torrent list, as described in 3.1 | this is optional lazy_read | will create objects with as little data as possible. List context Returns a list of Transmission::Torrent objects and sets the "torrents" attribute. Scalar context Returns an array-ref of Transmission::Torrent. rpc $any = $self->rpc($method, %args); Communicate with backend. This methods is meant for internal use. read_all 1 == $self->read_all; This method will try to populate ALL torrent, session and stats information, using three requests. LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. COPYRIGHT Copyright 2009-2013, Jan Henning Thorsen and contributors Current maintainer: Olof Johansson - "olof@cpan.org" Transmission-Client-0.0804/MANIFEST0000644000175000017500000000151212420764562015332 0ustar olofolofbin/transmission-client.pl Changes inc/Module/AutoInstall.pm inc/Module/Install.pm inc/Module/Install/AutoInstall.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Include.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Transmission/AttributeRole.pm lib/Transmission/Client.pm lib/Transmission/Session.pm lib/Transmission/Stats.pm lib/Transmission/Torrent.pm lib/Transmission/Torrent/File.pm lib/Transmission/Types.pm lib/Transmission/Utils.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml README t/00-load.t t/00-pod-coverage.t t/00-pod.t t/05-utils.t t/10-client.t t/10-torrent.t t/10-types.t t/20-real.t SIGNATURE Public-key signature (added by MakeMaker) Transmission-Client-0.0804/MANIFEST.SKIP0000644000175000017500000000013212215357007016066 0ustar olofolof^Transmission-Client ^pm_to_blib$ ^MYMETA\. ^blib/ \.bak$ ^Makefile$ ^\.git/ ^.gitignore$ Transmission-Client-0.0804/inc/0000755000175000017500000000000012420764562014753 5ustar olofolofTransmission-Client-0.0804/inc/Module/0000755000175000017500000000000012420764562016200 5ustar olofolofTransmission-Client-0.0804/inc/Module/AutoInstall.pm0000644000175000017500000006216212420764560021002 0ustar olofolof#line 1 package Module::AutoInstall; use strict; use Cwd (); use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # special map on pre-defined feature sets my %FeatureMap = ( '' => 'Core Features', # XXX: deprecated '-core' => 'Core Features', ); # various lexical flags my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $InstallDepsTarget, $HasCPANPLUS ); my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps, $UpgradeDeps ); my ( $PostambleActions, $PostambleActionsNoTest, $PostambleActionsUpgradeDeps, $PostambleActionsUpgradeDepsNoTest, $PostambleActionsListDeps, $PostambleActionsListAllDeps, $PostambleUsed, $NoTest); # See if it's a testing or non-interactive session _accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); _init(); sub _accept_default { $AcceptDefault = shift; } sub _installdeps_target { $InstallDepsTarget = shift; } sub missing_modules { return @Missing; } sub do_install { __PACKAGE__->install( [ $Config ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) : () ], @Missing, ); } # initialize various flags, and/or perform install sub _init { foreach my $arg ( @ARGV, split( /[\s\t]+/, $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || '' ) ) { if ( $arg =~ /^--config=(.*)$/ ) { $Config = [ split( ',', $1 ) ]; } elsif ( $arg =~ /^--installdeps=(.*)$/ ) { __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--upgradedeps=(.*)$/ ) { $UpgradeDeps = 1; __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--default(?:deps)?$/ ) { $AcceptDefault = 1; } elsif ( $arg =~ /^--check(?:deps)?$/ ) { $CheckOnly = 1; } elsif ( $arg =~ /^--skip(?:deps)?$/ ) { $SkipInstall = 1; } elsif ( $arg =~ /^--test(?:only)?$/ ) { $TestOnly = 1; } elsif ( $arg =~ /^--all(?:deps)?$/ ) { $AllDeps = 1; } } } # overrides MakeMaker's prompt() to automatically accept the default choice sub _prompt { goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; my ( $prompt, $default ) = @_; my $y = ( $default =~ /^[Yy]/ ); print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] '; print "$default\n"; return $default; } # the workhorse sub import { my $class = shift; my @args = @_ or return; my $core_all; print "*** $class version " . $class->VERSION . "\n"; print "*** Checking for Perl dependencies...\n"; my $cwd = Cwd::cwd(); $Config = []; my $maxlen = length( ( sort { length($b) <=> length($a) } grep { /^[^\-]/ } map { ref($_) ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} ) : '' } map { +{@args}->{$_} } grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} } )[0] ); # We want to know if we're under CPAN early to avoid prompting, but # if we aren't going to try and install anything anyway then skip the # check entirely since we don't want to have to load (and configure) # an old CPAN just for a cosmetic message $UnderCPAN = _check_lock(1) unless $SkipInstall || $InstallDepsTarget; while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) { my ( @required, @tests, @skiptests ); my $default = 1; my $conflict = 0; if ( $feature =~ m/^-(\w+)$/ ) { my $option = lc($1); # check for a newer version of myself _update_to( $modules, @_ ) and return if $option eq 'version'; # sets CPAN configuration options $Config = $modules if $option eq 'config'; # promote every features to core status $core_all = ( $modules =~ /^all$/i ) and next if $option eq 'core'; next unless $option eq 'core'; } print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n"; $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' ); unshift @$modules, -default => &{ shift(@$modules) } if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) { if ( $mod =~ m/^-(\w+)$/ ) { my $option = lc($1); $default = $arg if ( $option eq 'default' ); $conflict = $arg if ( $option eq 'conflict' ); @tests = @{$arg} if ( $option eq 'tests' ); @skiptests = @{$arg} if ( $option eq 'skiptests' ); next; } printf( "- %-${maxlen}s ...", $mod ); if ( $arg and $arg =~ /^\D/ ) { unshift @$modules, $arg; $arg = 0; } # XXX: check for conflicts and uninstalls(!) them. my $cur = _version_of($mod); if (_version_cmp ($cur, $arg) >= 0) { print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n"; push @Existing, $mod => $arg; $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { if (not defined $cur) # indeed missing { print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n"; } else { # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above print "too old. ($cur < $arg)\n"; } push @required, $mod => $arg; } } next unless @required; my $mandatory = ( $feature eq '-core' or $core_all ); if ( !$SkipInstall and ( $CheckOnly or ($mandatory and $UnderCPAN) or $AllDeps or $InstallDepsTarget or _prompt( qq{==> Auto-install the } . ( @required / 2 ) . ( $mandatory ? ' mandatory' : ' optional' ) . qq{ module(s) from CPAN?}, $default ? 'y' : 'n', ) =~ /^[Yy]/ ) ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } elsif ( !$SkipInstall and $default and $mandatory and _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', ) =~ /^[Nn]/ ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { $DisabledTests{$_} = 1 for map { glob($_) } @tests; } } if ( @Missing and not( $CheckOnly or $UnderCPAN) ) { require Config; my $make = $Config::Config{make}; if ($InstallDepsTarget) { print "*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n"; } else { print "*** Dependencies will be installed the next time you type '$make'.\n"; } # make an educated guess of whether we'll need root permission. print " (You may need to do that as the 'root' user.)\n" if eval '$>'; } print "*** $class configuration finished.\n"; chdir $cwd; # import to main:: no strict 'refs'; *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; return (@Existing, @Missing); } sub _running_under { my $thing = shift; print <<"END_MESSAGE"; *** Since we're running under ${thing}, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } # Check to see if we are currently running under CPAN.pm and/or CPANPLUS; # if we are, then we simply let it taking care of our dependencies sub _check_lock { return unless @Missing or @_; if ($ENV{PERL5_CPANM_IS_RUNNING}) { return _running_under('cpanminus'); } my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING}; if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) { return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS'); } require CPAN; if ($CPAN::VERSION > '1.89') { if ($cpan_env) { return _running_under('CPAN'); } return; # CPAN.pm new enough, don't need to check further } # last ditch attempt, this -will- configure CPAN, very sorry _load_cpan(1); # force initialize even though it's already loaded # Find the CPAN lock-file my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" ); return unless -f $lock; # Check the lock local *LOCK; return unless open(LOCK, $lock); if ( ( $^O eq 'MSWin32' ? _under_cpan() : == getppid() ) and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore' ) { print <<'END_MESSAGE'; *** Since we're running under CPAN, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } close LOCK; return; } sub install { my $class = shift; my $i; # used below to strip leading '-' from config keys my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } ); my ( @modules, @installed ); while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) { # grep out those already installed if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) { push @installed, $pkg; } else { push @modules, $pkg, $ver; } } if ($UpgradeDeps) { push @modules, @installed; @installed = (); } return @installed unless @modules; # nothing to do return @installed if _check_lock(); # defer to the CPAN shell print "*** Installing dependencies...\n"; return unless _connected_to('cpan.org'); my %args = @config; my %failed; local *FAILED; if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) { while () { chomp; $failed{$_}++ } close FAILED; my @newmod; while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) { push @newmod, ( $k => $v ) unless $failed{$k}; } @modules = @newmod; } if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) { _install_cpanplus( \@modules, \@config ); } else { _install_cpan( \@modules, \@config ); } print "*** $class installation finished.\n"; # see if we have successfully installed them while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) { push @installed, $pkg; } elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) { print FAILED "$pkg\n"; } } close FAILED if $args{do_once}; return @installed; } sub _install_cpanplus { my @modules = @{ +shift }; my @config = _cpanplus_config( @{ +shift } ); my $installed = 0; require CPANPLUS::Backend; my $cp = CPANPLUS::Backend->new; my $conf = $cp->configure_object; return unless $conf->can('conf') # 0.05x+ with "sudo" support or _can_write($conf->_get_build('base')); # 0.04x # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $conf->get_conf('makeflags') || ''; if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) { # 0.03+ uses a hashref here $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; } else { # 0.02 and below uses a scalar $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); } $conf->set_conf( makeflags => $makeflags ); $conf->set_conf( prereqs => 1 ); while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) { $conf->set_conf( $key, $val ); } my $modtree = $cp->module_tree; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { print "*** Installing $pkg...\n"; MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; my $success; my $obj = $modtree->{$pkg}; if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $cp->install( modules => [ $obj->{module} ] ); if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation cancelled.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _cpanplus_config { my @config = (); while ( @_ ) { my ($key, $value) = (shift(), shift()); if ( $key eq 'prerequisites_policy' ) { if ( $value eq 'follow' ) { $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL(); } elsif ( $value eq 'ask' ) { $value = CPANPLUS::Internals::Constants::PREREQ_ASK(); } elsif ( $value eq 'ignore' ) { $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE(); } else { die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n"; } push @config, 'prereqs', $value; } elsif ( $key eq 'force' ) { push @config, $key, $value; } elsif ( $key eq 'notest' ) { push @config, 'skiptest', $value; } else { die "*** Cannot convert option $key to CPANPLUS version.\n"; } } return @config; } sub _install_cpan { my @modules = @{ +shift }; my @config = @{ +shift }; my $installed = 0; my %args; _load_cpan(); require Config; if (CPAN->VERSION < 1.80) { # no "sudo" support, probe for writableness return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) ) and _can_write( $Config::Config{sitelib} ); } # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $CPAN::Config->{make_install_arg} || ''; $CPAN::Config->{make_install_arg} = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); # don't show start-up info $CPAN::Config->{inhibit_startup_message} = 1; # set additional options while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) { ( $args{$opt} = $arg, next ) if $opt =~ /^(?:force|notest)$/; # pseudo-option $CPAN::Config->{$opt} = $arg; } if ($args{notest} && (not CPAN::Shell->can('notest'))) { die "Your version of CPAN is too old to support the 'notest' pragma"; } local $CPAN::Config->{prerequisites_policy} = 'follow'; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; print "*** Installing $pkg...\n"; my $obj = CPAN::Shell->expand( Module => $pkg ); my $success = 0; if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = do { if ($args{force}) { CPAN::Shell->force( install => $pkg ) } elsif ($args{notest}) { CPAN::Shell->notest( install => $pkg ) } else { CPAN::Shell->install($pkg) } }; $rv ||= eval { $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, ) ->{install} if $CPAN::META; }; if ( $rv eq 'YES' ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation failed.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _has_cpanplus { return ( $HasCPANPLUS = ( $INC{'CPANPLUS/Config.pm'} or _load('CPANPLUS::Shell::Default') ) ); } # make guesses on whether we're under the CPAN installation directory sub _under_cpan { require Cwd; require File::Spec; my $cwd = File::Spec->canonpath( Cwd::cwd() ); my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} ); return ( index( $cwd, $cpan ) > -1 ); } sub _update_to { my $class = __PACKAGE__; my $ver = shift; return if _version_cmp( _version_of($class), $ver ) >= 0; # no need to upgrade if ( _prompt( "==> A newer version of $class ($ver) is required. Install?", 'y' ) =~ /^[Nn]/ ) { die "*** Please install $class $ver manually.\n"; } print << "."; *** Trying to fetch it from CPAN... . # install ourselves _load($class) and return $class->import(@_) if $class->install( [], $class, $ver ); print << '.'; exit 1; *** Cannot bootstrap myself. :-( Installation terminated. . } # check if we're connected to some host, using inet_aton sub _connected_to { my $site = shift; return ( ( _load('Socket') and Socket::inet_aton($site) ) or _prompt( qq( *** Your host cannot resolve the domain name '$site', which probably means the Internet connections are unavailable. ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/ ); } # check if a directory is writable; may create it on demand sub _can_write { my $path = shift; mkdir( $path, 0755 ) unless -e $path; return 1 if -w $path; print << "."; *** You are not allowed to write to the directory '$path'; the installation may fail due to insufficient permissions. . if ( eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt( qq( ==> Should we try to re-execute the autoinstall process with 'sudo'?), ((-t STDIN) ? 'y' : 'n') ) =~ /^[Yy]/ ) { # try to bootstrap ourselves from sudo print << "."; *** Trying to re-execute the autoinstall process with 'sudo'... . my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; return unless system( 'sudo', $^X, $0, "--config=$config", "--installdeps=$missing" ); print << "."; *** The 'sudo' command exited with error! Resuming... . } return _prompt( qq( ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/; } # load a module and return the version it reports sub _load { my $mod = pop; # method/function doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; local $@; return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 ); } # report version without loading a module sub _version_of { my $mod = pop; # method/function doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; foreach my $dir ( @INC ) { next if ref $dir; my $path = File::Spec->catfile($dir, $file); next unless -e $path; require ExtUtils::MM_Unix; return ExtUtils::MM_Unix->parse_version($path); } return undef; } # Load CPAN.pm and it's configuration sub _load_cpan { return if $CPAN::VERSION and $CPAN::Config and not @_; require CPAN; # CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to # CPAN::HandleConfig->load. CPAN reports that the redirection # is deprecated in a warning printed at the user. # CPAN-1.81 expects CPAN::HandleConfig->load, does not have # $CPAN::HandleConfig::VERSION but cannot handle # CPAN::Config->load # Which "versions expect CPAN::Config->load? if ( $CPAN::HandleConfig::VERSION || CPAN::HandleConfig->can('load') ) { # Newer versions of CPAN have a HandleConfig module CPAN::HandleConfig->load; } else { # Older versions had the load method in Config directly CPAN::Config->load; } } # compare two versions, either use Sort::Versions or plain comparison # return values same as <=> sub _version_cmp { my ( $cur, $min ) = @_; return -1 unless defined $cur; # if 0 keep comparing return 1 unless $min; $cur =~ s/\s+$//; # check for version numbers that are not in decimal format if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) { if ( ( $version::VERSION or defined( _load('version') )) and version->can('new') ) { # use version.pm if it is installed. return version->new($cur) <=> version->new($min); } elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) ) { # use Sort::Versions as the sorting algorithm for a.b.c versions return Sort::Versions::versioncmp( $cur, $min ); } warn "Cannot reliably compare non-decimal formatted versions.\n" . "Please install version.pm or Sort::Versions.\n"; } # plain comparison local $^W = 0; # shuts off 'not numeric' bugs return $cur <=> $min; } # nothing; this usage is deprecated. sub main::PREREQ_PM { return {}; } sub _make_args { my %args = @_; $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing } if $UnderCPAN or $TestOnly; if ( $args{EXE_FILES} and -e 'MANIFEST' ) { require ExtUtils::Manifest; my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); $args{EXE_FILES} = [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ]; } $args{test}{TESTS} ||= 't/*.t'; $args{test}{TESTS} = join( ' ', grep { !exists( $DisabledTests{$_} ) } map { glob($_) } split( /\s+/, $args{test}{TESTS} ) ); my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; $PostambleActions = ( ($missing and not $UnderCPAN) ? "\$(PERL) $0 --config=$config --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); my $deps_list = join( ',', @Missing, @Existing ); $PostambleActionsUpgradeDeps = "\$(PERL) $0 --config=$config --upgradedeps=$deps_list"; my $config_notest = join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}), 'notest', 1 ) if $Config; $PostambleActionsNoTest = ( ($missing and not $UnderCPAN) ? "\$(PERL) $0 --config=$config_notest --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); $PostambleActionsUpgradeDepsNoTest = "\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list"; $PostambleActionsListDeps = '@$(PERL) -le "print for @ARGV" ' . join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing); my @all = (@Missing, @Existing); $PostambleActionsListAllDeps = '@$(PERL) -le "print for @ARGV" ' . join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all); return %args; } # a wrapper to ExtUtils::MakeMaker::WriteMakefile sub Write { require Carp; Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; if ($CheckOnly) { print << "."; *** Makefile not written in check-only mode. . return; } my %args = _make_args(@_); no strict 'refs'; $PostambleUsed = 0; local *MY::postamble = \&postamble unless defined &MY::postamble; ExtUtils::MakeMaker::WriteMakefile(%args); print << "." unless $PostambleUsed; *** WARNING: Makefile written with customized MY::postamble() without including contents from Module::AutoInstall::postamble() -- auto installation features disabled. Please contact the author. . return 1; } sub postamble { $PostambleUsed = 1; my $fragment; $fragment .= <<"AUTO_INSTALL" if !$InstallDepsTarget; config :: installdeps \t\$(NOECHO) \$(NOOP) AUTO_INSTALL $fragment .= <<"END_MAKE"; checkdeps :: \t\$(PERL) $0 --checkdeps installdeps :: \t$PostambleActions installdeps_notest :: \t$PostambleActionsNoTest upgradedeps :: \t$PostambleActionsUpgradeDeps upgradedeps_notest :: \t$PostambleActionsUpgradeDepsNoTest listdeps :: \t$PostambleActionsListDeps listalldeps :: \t$PostambleActionsListAllDeps END_MAKE return $fragment; } 1; __END__ #line 1193 Transmission-Client-0.0804/inc/Module/Install.pm0000644000175000017500000003013512420764560020144 0ustar olofolof#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.06'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. Transmission-Client-0.0804/inc/Module/Install/0000755000175000017500000000000012420764562017606 5ustar olofolofTransmission-Client-0.0804/inc/Module/Install/Win32.pm0000644000175000017500000000340312420764560021044 0ustar olofolof#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Transmission-Client-0.0804/inc/Module/Install/Can.pm0000644000175000017500000000615712420764560020654 0ustar olofolof#line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 Transmission-Client-0.0804/inc/Module/Install/Makefile.pm0000644000175000017500000002743712420764560021674 0ustar olofolof#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 Transmission-Client-0.0804/inc/Module/Install/AutoInstall.pm0000644000175000017500000000416212420764560022404 0ustar olofolof#line 1 package Module::Install::AutoInstall; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub AutoInstall { $_[0] } sub run { my $self = shift; $self->auto_install_now(@_); } sub write { my $self = shift; $self->auto_install(@_); } sub auto_install { my $self = shift; return if $self->{done}++; # Flatten array of arrays into a single array my @core = map @$_, map @$_, grep ref, $self->build_requires, $self->requires; my @config = @_; # We'll need Module::AutoInstall $self->include('Module::AutoInstall'); require Module::AutoInstall; my @features_require = Module::AutoInstall->import( (@config ? (-config => \@config) : ()), (@core ? (-core => \@core) : ()), $self->features, ); my %seen; my @requires = map @$_, map @$_, grep ref, $self->requires; while (my ($mod, $ver) = splice(@requires, 0, 2)) { $seen{$mod}{$ver}++; } my @build_requires = map @$_, map @$_, grep ref, $self->build_requires; while (my ($mod, $ver) = splice(@build_requires, 0, 2)) { $seen{$mod}{$ver}++; } my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires; while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) { $seen{$mod}{$ver}++; } my @deduped; while (my ($mod, $ver) = splice(@features_require, 0, 2)) { push @deduped, $mod => $ver unless $seen{$mod}{$ver}++; } $self->requires(@deduped); $self->makemaker_args( Module::AutoInstall::_make_args() ); my $class = ref($self); $self->postamble( "# --- $class section:\n" . Module::AutoInstall::postamble() ); } sub installdeps_target { my ($self, @args) = @_; $self->include('Module::AutoInstall'); require Module::AutoInstall; Module::AutoInstall::_installdeps_target(1); $self->auto_install(@args); } sub auto_install_now { my $self = shift; $self->auto_install(@_); Module::AutoInstall::do_install(); } 1; Transmission-Client-0.0804/inc/Module/Install/WriteAll.pm0000644000175000017500000000237612420764560021675 0ustar olofolof#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; Transmission-Client-0.0804/inc/Module/Install/Metadata.pm0000644000175000017500000004327712420764560021677 0ustar olofolof#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Transmission-Client-0.0804/inc/Module/Install/Fetch.pm0000644000175000017500000000462712420764560021204 0ustar olofolof#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Transmission-Client-0.0804/inc/Module/Install/Include.pm0000644000175000017500000000101512420764560021522 0ustar olofolof#line 1 package Module::Install::Include; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub include { shift()->admin->include(@_); } sub include_deps { shift()->admin->include_deps(@_); } sub auto_include { shift()->admin->auto_include(@_); } sub auto_include_deps { shift()->admin->auto_include_deps(@_); } sub auto_include_dependent_dists { shift()->admin->auto_include_dependent_dists(@_); } 1; Transmission-Client-0.0804/inc/Module/Install/Base.pm0000644000175000017500000000214712420764560021020 0ustar olofolof#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 Transmission-Client-0.0804/SIGNATURE0000644000175000017500000000710712420764571015473 0ustar olofolofThis file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.73. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 dafc5864d114d73797fa5f975c7e3ef9ad325f15 Changes SHA1 6272f6705e8869321d3eda276c7e0b7e7e303930 MANIFEST SHA1 9c6195dde9986212699ac40813eb37601fc48db3 MANIFEST.SKIP SHA1 bb66805f9204d9800b377809d999751de4733beb META.yml SHA1 0609624a41e41411aeb5cb3925af54c00d749fe6 Makefile.PL SHA1 4aa75ad59560c70911fa86a71e671317d97b60aa README SHA1 fe12845a06227e1efbc38e6ce1e65be91bcca9ac bin/transmission-client.pl SHA1 06c410f05488c1612ed66b06d3a86b2580581e4a inc/Module/AutoInstall.pm SHA1 8a924add836b60fb23b25c8506d45945e02f42f4 inc/Module/Install.pm SHA1 61ab1dd37e33ddbe155907ce51df8a3e56ac8bbf inc/Module/Install/AutoInstall.pm SHA1 2d0fad3bf255f8c1e7e1e34eafccc4f595603ddc inc/Module/Install/Base.pm SHA1 f0e01fff7d73cd145fbf22331579918d4628ddb0 inc/Module/Install/Can.pm SHA1 7328966e4fda0c8451a6d3850704da0b84ac1540 inc/Module/Install/Fetch.pm SHA1 66d3d335a03492583a3be121a7d888f63f08412c inc/Module/Install/Include.pm SHA1 b62ca5e2d58fa66766ccf4d64574f9e1a2250b34 inc/Module/Install/Makefile.pm SHA1 1aa925be410bb3bfcd84a16985921f66073cc1d2 inc/Module/Install/Metadata.pm SHA1 e4196994fa75e98bdfa2be0bdeeffef66de88171 inc/Module/Install/Win32.pm SHA1 c3a6d0d5b84feb3280622e9599e86247d58b0d18 inc/Module/Install/WriteAll.pm SHA1 edc750486cb6911cbf22cf34ba380c67c9c92036 lib/Transmission/AttributeRole.pm SHA1 7a62166d63e99130696beec4ccbd4bdcfe28bba4 lib/Transmission/Client.pm SHA1 11202a5076d86bf99eeeebc0aa409b37c267f8f0 lib/Transmission/Session.pm SHA1 5528f808ad751231a3f2cf56f7d863df35ddac42 lib/Transmission/Stats.pm SHA1 7f030e485a5aee3e7d15d224f7df759340fa3f74 lib/Transmission/Torrent.pm SHA1 1b81c2d63dfe3b503fab6e50e07a2ff38e3769d2 lib/Transmission/Torrent/File.pm SHA1 ff54868614dabaaf5c4f10097c987803288df16c lib/Transmission/Types.pm SHA1 d4a58883248d6de7b3f16449f590f239f7c12665 lib/Transmission/Utils.pm SHA1 97edfe3f9c9622e867a9e3c1ca8716c9fb548494 t/00-load.t SHA1 883ff308e3ecd9acd2ce28ffd27e230df83ad6a9 t/00-pod-coverage.t SHA1 beba99dd1875b0f83c7662f2f932e69731ceeae2 t/00-pod.t SHA1 ea06e8f607c61c88273352b2c8d88c2877fe988e t/05-utils.t SHA1 a35a95c29cdbd3bfebb4937f83312d8599c736d2 t/10-client.t SHA1 6860c5531dcee144168ee720402f94fc69699eb7 t/10-torrent.t SHA1 1ccbfc08071ab4ea3a76949e9333de508a5560df t/10-types.t SHA1 385390cb7ad6483281fdefdbbdb03861450fec1b t/20-real.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1 iQIcBAEBAgAGBQJUQ+lzAAoJEFDVLxLOThOZDCQQAKCRHVRUGLqlua4Wy0SfEPNC 6WipYqsspdN5jIPi8479SOOvUDPg96Vc6JiPCqg+iBehW4Nx1qsJZhQbUrAE9/i/ 2vxjjcNwtsy2RjFA8KS2wRim3aF/YODWdd33DNZRayKIUHZ3yBBaRng5wRscKqrM SuEUTuMyLllLL/ti52koFKJDloRtSDFmQwA78isUCas5BPBHlCaEQlsde/y3RJYK jhfRONj/UJIGv/SUqY9gnnWvsKUPNBAWJ62hp2cgYNhpW5lJBzrnRQ0HnRyrK/l2 R9DUNE9+T/CzB4PavKioLdstoFGHmQi7SeJtdgDXyewwrmRfWugWQ2OE+YDp/bG5 +73Mn6C0Zr3IPjdEmc3rqjLh1PxpUSr/B0nECjFC3V4/R7J/jXoM+K3BQv6TjjwY no7gFLFx8BZUrGySL6ZCmeDUiE7eNvXBv/L2t+b3wcODjOkuhNAKRD6+LTjFN+K2 d14erHgNbpjNn1q/PguDVRQUG1cvf3UEKvGuE1O3JLE77ETONQ5eNxHk8EjiiyAj 9aBE6k/F6yYk9okDUCPyrPByHLS66ik8kUeR9y6SxDcwV2WPxX4W1X+nl2mSua6r ChnZVcRcd7V6RmcggmGT6hf6ig+uGQB5TErAK/UbvFczy2+PrisB2j97YTCBiNSQ 6rsZa2LwG4WeQSotMzKF =gq23 -----END PGP SIGNATURE-----