Permalink
Browse files

first commit

  • Loading branch information...
0 parents commit 1ca8b77fb622ae6162cf294f3720cbf94ab3e69e @pmakholm committed Apr 4, 2009
@@ -0,0 +1,5 @@
+Revision history for WebService-Telnic
+
+0.01 Date/time
+ First version, released on an unsuspecting world.
+
@@ -0,0 +1,16 @@
+Changes
+examples/tel-profile.pl
+examples/tel-qotd.pl
+lib/WebService/Telnic.pm
+lib/WebService/Telnic/Base.pm
+lib/WebService/Telnic/Client.pm
+lib/WebService/Telnic/Client/Profile.pm
+lib/WebService/Telnic/Client/Record.pm
+lib/WebService/Telnic/Client/RR.pm
+Makefile.PL
+MANIFEST This list of files
+README
+t/00-load.t
+t/boilerplate.t
+t/pod-coverage.t
+t/pod.t
@@ -0,0 +1,16 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'WebService::Telnic',
+ AUTHOR => 'Peter Makholm <peter@makholm.net>',
+ VERSION_FROM => 'lib/WebService/Telnic.pm',
+ ABSTRACT_FROM => 'lib/WebService/Telnic.pm',
+ PL_FILES => {},
+ PREREQ_PM => {
+ 'Test::More' => 0,
+ },
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'WebService-Telnic-*' },
+);
52 README
@@ -0,0 +1,52 @@
+WebService-Telnic
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the README
+file from a module distribution so that people browsing the archive
+can use it to get an idea of the module's uses. It is usually a good idea
+to provide version information here so that people can decide whether
+fixes for the module are worth downloading.
+
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the
+perldoc command.
+
+ perldoc WebService::Telnic
+
+You can also look for information at:
+
+ RT, CPAN's request tracker
+ http://rt.cpan.org/NoAuth/Bugs.html?Dist=WebService-Telnic
+
+ AnnoCPAN, Annotated CPAN documentation
+ http://annocpan.org/dist/WebService-Telnic
+
+ CPAN Ratings
+ http://cpanratings.perl.org/d/WebService-Telnic
+
+ Search CPAN
+ http://search.cpan.org/dist/WebService-Telnic
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2009 Peter Makholm
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use WebService::Telnic::Client;
+use Getopt::Long;
+
+my ($endpoint, $domain, $user, $pass, $list, $set);
+GetOptions(
+ 'endpoint=s' => \$endpoint,
+ 'domain=s' => \$domain,
+ 'user=s' => \$user,
+ 'pass=s' => \$pass,
+ 'list' => \$list,
+ 'set=s' => \$set,
+);
+
+die 'endpoint, domain, user, and pass is all needed' unless
+ $endpoint && $domain && $user && $pass;
+
+die 'One and only one of --list or --set' if ($list && $set) || (!$list && !$set);
+
+my $client = WebService::Telnic::Client->new(
+ endpoint => $endpoint,
+ user => $user,
+ pass => $pass,
+);
+
+if ($list) {
+ my $profiles = $client->listProfilesExt($domain);
+
+ for my $profile (@{ $profiles->{profile} }) {
+ print ($profile->{id} == $profiles->{active} ? '*' : ' ');
+ print $profile->{id}, "\t", $profile->{name}, "\n";
+ }
+} else {
+ my $res = $client->switchToProfile($domain, id => $set);
+ print $res ? "Succedded\n" : "failed\n";
+}
+
+
+
@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use WebService::Telnic::Client;
+use Net::DNS::RR;
+use List::Util qw(shuffle);
+use Getopt::Long;
+
+my @quotes = shuffle <DATA>;
+chomp @quotes;
+
+my ($endpoint, $domain, $user, $pass);
+GetOptions(
+ 'endpoint=s' => \$endpoint,
+ 'domain=s' => \$domain,
+ 'user=s' => \$user,
+ 'pass=s' => \$pass,
+);
+
+die 'endpoint, domain, user, and pass is all needed' unless
+ $endpoint && $domain && $user && $pass;
+
+my $client = WebService::Telnic::Client->new(
+ endpoint => $endpoint,
+ user => $user,
+ pass => $pass,
+);
+
+my $qotd;
+for my $record (@{ $client->listRecords($domain) }) {
+ next unless $record->isa('Net::DNS::RR::TXT');
+
+ my ($type) = $record->char_str_list();
+ next unless $type eq "Quote of the day";
+
+ $qotd = $record;
+ last;
+}
+
+unless (defined $qotd) {
+ $qotd = Net::DNS::RR->new(
+ type => 'TXT',
+ name => $domain,
+ );
+}
+
+# Net::DNS::RR::TXT doesn't have a nice accessor?
+$qotd->{'char_str_list'} = [
+ 'Quote of the day',
+ shift @quotes,
+];
+
+$client->storeRecord($domain, $qotd);
+
+__DATA__
+alpha
+beta
+gamma
+delta
+
@@ -0,0 +1,107 @@
+package WebService::Telnic;
+
+use warnings;
+use strict;
+
+=head1 NAME
+
+WebService::Telnic - The great new WebService::Telnic!
+
+=head1 VERSION
+
+Version 0.1
+
+=cut
+
+our $VERSION = '0.1';
+
+
+=head1 SYNOPSIS
+
+Quick summary of what the module does.
+
+Perhaps a little code snippet.
+
+ use WebService::Telnic;
+
+ my $foo = WebService::Telnic->new();
+ ...
+
+=head1 EXPORT
+
+A list of functions that can be exported. You can delete this section
+if you don't export anything, such as for a purely object-oriented module.
+
+=head1 FUNCTIONS
+
+=head2 function1
+
+=cut
+
+sub function1 {
+}
+
+=head2 function2
+
+=cut
+
+sub function2 {
+}
+
+=head1 AUTHOR
+
+Peter Makholm, C<< <peter at makholm.net> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-webservice-telnic at rt.cpan.org>, or through
+the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=WebService-Telnic>. I will be notified, and then you'll
+automatically be notified of progress on your bug as I make changes.
+
+
+
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc WebService::Telnic
+
+
+You can also look for information at:
+
+=over 4
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=WebService-Telnic>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/WebService-Telnic>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/WebService-Telnic>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/WebService-Telnic>
+
+=back
+
+
+=head1 ACKNOWLEDGEMENTS
+
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2009 Peter Makholm, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+
+=cut
+
+1; # End of WebService::Telnic
@@ -0,0 +1,65 @@
+package WebService::Telnic::Base;
+
+use warnings;
+use strict;
+
+use LWP::UserAgent;
+use HTTP::Request;
+
+our $VERSION = '0.1';
+
+sub new {
+ my $class = shift;
+ my %args = @_;
+
+ my $uri = URI->new($args{endpoint});
+
+ my $ua = LWP::UserAgent->new(
+ agent => "WebService::Telnic/$VERSION",
+ );
+
+ $ua->credentials( $uri->host_port, 'client-api', $args{user}, $args{pass});
+ my $req = HTTP::Request->new( POST => $args{endpoint} );
+ $req->header( Accept => 'application/soap+xml' );
+ $req->content_type( 'application/soap+xml' );
+
+
+ return bless {
+ args => \%args,
+ ua => $ua,
+ req => $req,
+ namespaces => {}
+ }, $class;
+}
+
+sub soap {
+ my $self = shift;
+ my $method = shift;
+ my $body = shift;
+
+ my $req = $self->{req}->clone();
+
+ my $namespaces;
+ $namespaces .= qq( xmlns:$_="$self->{namespaces}->{$_}" ) for keys %{$self->{namespaces}};
+
+ $req->header( SOAPAction => $method );
+ $req->content(<<EOF);
+<?xml version="1.0" encoding="UTF-8"?>
+<soap:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+ xmlns:soapenc="http://www.w3.org/2003/05/soap-encoding"
+ xmlns:xsd="http://www.w3.org/2001/XMLSchema"
+ soap:encodingStyle="http://www.w3.org/2003/05/soap-encoding"
+ xmlns:soap="http://www.w3.org/2003/05/soap-envelope"
+ $namespaces>
+ <soap:Body>
+ $body
+ </soap:Body>
+</soap:Envelope>
+EOF
+
+ my $response = $self->{ua}->request($req);
+
+ return $response;
+}
+
+1; # End of WebService::Telnic::Base
Oops, something went wrong.

0 comments on commit 1ca8b77

Please sign in to comment.