Skip to content
Browse files

initial commit

  • Loading branch information...
0 parents commit 8cb960cbdf20d513a102289eb646c0b84490a2f3 sshaw committed Dec 3, 2011
Showing with 149 additions and 0 deletions.
  1. +4 −0 MANIFEST
  2. +25 −0 Makefile.PL
  3. +86 −0 lib/URI/fasp.pm
  4. +34 −0 t/fasp.t
4 MANIFEST
@@ -0,0 +1,4 @@
+lib/URI/fasp.pm
+Makefile.PL
+MANIFEST This list of files
+t/fasp.t
25 Makefile.PL
@@ -0,0 +1,25 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'URI::fasp',
+ AUTHOR => 'Skye Shaw <sshaw AT lucas.cis.temple.edu>',
+ PREREQ_PM => { URI => '1.18' },
+ LICENSE => 'perl',
+ VERSION_FROM => 'lib/URI/fasp.pm',
+ ABSTRACT_FROM => 'lib/URI/fasp.pm',
+ (eval { ExtUtils::MakeMaker->VERSION(6.46) } ?
+ (META_MERGE => { resources => { bugtracker => 'http://github.com/sshaw/URI-fasp/issues' } }) : ())
+);
+
+
+# Create README.pod for a repo's GitHub page. Unlike CPAN, GitHub won't
+# display the module's POD, it looks for a README.*
+sub MY::postamble
+{
+ my $self = shift;
+ return if -r 'README' or ! -r $self->{VERSION_FROM};
+ return<<END_MAKE;
+README.pod: $self->{VERSION_FROM}
+ \@perldoc -uT $self->{VERSION_FROM} > README.pod
+END_MAKE
+}
86 lib/URI/fasp.pm
@@ -0,0 +1,86 @@
+package URI::fasp;
+
+#https://support.asperasoft.com/entries/20153151-http-fallback-configuration-testing-and-troubleshooting
+
+use strict;
+use warnings;
+use base 'URI::ssh';
+
+use URI::QueryParam;
+
+our $VERSION = '0.01';
+
+sub _init
+{
+ my $class = shift;
+ my $self = $class->SUPER::_init(@_);
+ $self->faspport($self->default_faspport) unless defined $self->faspport;
+ # Other defaults
+ $self;
+}
+
+sub bwcap { shift->_query_param('bwcap', @_); }
+sub policy { shift->_query_param('policy', @_); }
+sub httpport { shift->_query_param('httpport', @_); }
+sub targetrate { shift->_query_param('targetrate', @_); }
+sub default_faspport { 33001 }
+
+sub faspport
+{
+ my $self = shift;
+ return $self->_query_param('port', @_) if @_;
+ my $port = $self->query_param('port') ||
+ $self->query_param('faspport');
+ $port;
+}
+
+sub as_ssh
+{
+ my $self = shift;
+ my $ssh = $self->clone;
+ $ssh->scheme('ssh');
+ $ssh->query(undef);
+ $ssh;
+}
+
+sub _query_param
+{
+ my ($self, $param, $value) = @_;
+
+ # Do we need to accept multiple args here?
+ if($value) {
+ $self->query_param($param, $value);
+ return;
+ }
+
+ $self->query_param($param);
+}
+
+1;
+
+=pod
+
+=head1 NAME
+
+URI::fasp - URI handler for Aspera's FASP protocol
+
+=head1 SYNOPSIS
+
+ $fasp = URI->new('fasp://example.com:97001?port=33001&bwcap=25000');
+ $fasp->targetrate(10_000);
+
+ print $fasp->port; # 97001
+ print $fasp->faspport; # 33001
+ print $fasp->bwcap; # 25000
+ # ...
+ $ssh = $fasp->as_ssh; # URI::ssh
+ print $ssh->port; # 97001
+
+=head1 METHODS
+
+
+
+=head1 SEE ALSO
+
+L<URI>, http://asperasoft.com
+
34 t/fasp.t
@@ -0,0 +1,34 @@
+use strict;
+use warnings;
+
+use URI;
+use Test::More tests => 15;
+
+my $uri = URI->new('fasp://example.com');
+isa_ok($uri, 'URI::fasp');
+is($uri->port, 22);
+is($uri->default_faspport, 33001);
+is($uri->faspport, 33001);
+
+$uri = URI->new('fasp://example.com:33001?port=5000&bwcap=1000&policy=fair&httpport=8080&targetrate=50000');
+is($uri->faspport, 5000);
+is($uri->bwcap, 1000);
+is($uri->policy, 'fair');
+is($uri->httpport, 8080);
+is($uri->targetrate, 50000);
+
+$uri->faspport(33001);
+is($uri->faspport, 33001);
+
+$uri->bwcap(25000);
+is($uri->bwcap, 25000);
+
+$uri->policy('unlimited');
+is($uri->policy, 'unlimited');
+
+$uri->targetrate(100000);
+is($uri->targetrate, 100000);
+
+my $ssh = $uri->as_ssh;
+isa_ok($ssh, 'URI::ssh');
+is($ssh->port, 33001);

0 comments on commit 8cb960c

Please sign in to comment.
Something went wrong with that request. Please try again.