Skip to content
Browse files

prep for release

  • Loading branch information...
1 parent fb30c57 commit c389524f901e25f0cd9b10d865dde980ddc09c80 @pudge pudge committed
View
5 Slash/Client/.releaserc
@@ -1 +1,6 @@
cpan_user=CNANDOR
+sf_user=pudge
+sf_group_id=4421
+sf_package_id=170031
+sf_release_match=^.+-([\d.]+)$
+sf_release_replace=$1
View
4 Slash/Client/MANIFEST
@@ -1,5 +1,5 @@
-Client.pm
-Journal/Journal.pm
+lib/Slash/Client.pm
+lib/Slash/Client/Journal.pm
Makefile.PL
MANIFEST
README
View
5 Slash/Client/Makefile.PL
@@ -2,9 +2,12 @@ use ExtUtils::MakeMaker;
WriteMakefile(
'NAME' => 'Slash::Client',
- 'VERSION_FROM' => 'Client.pm',
+ 'VERSION_FROM' => 'lib/Slash/Client.pm',
'clean' => {
'FILES' => 'Slash-Client-*'
},
'NO_META' => 1,
+ 'PREREQ_PM' => {
+ 'SOAP::Lite' => 0,
+ },
);
View
206 Slash/Client/lib/Slash/Client.pm
@@ -0,0 +1,206 @@
+# This code is a part of Slash, and is released under the GPL.
+# Copyright 1997-2005 by Open Source Technology Group. See README
+# and COPYING for more information, or see http://slashcode.com/.
+# $Id$
+
+package Slash::Client;
+
+use strict;
+use warnings;
+
+use Digest::MD5 'md5_hex';
+use File::Spec::Functions;
+
+our $VERSION = 0.01;
+
+sub new {
+ my($class, $opts) = @_;
+
+ my $self = {};
+ $self->{host} = $opts->{host} or return;
+ $self->{http} = $opts->{ssl} ? 'https' : 'http';
+
+ $self->{uid} = $opts->{uid};
+ $self->{pass} = $opts->{pass};
+ $self->{logtoken} = $opts->{logtoken};
+ $self->{cookie_file} = $opts->{cookie_file};
+
+ bless $self, $class;
+ return $self;
+}
+
+sub soap {
+ my($self) = @_;
+ my $uri = $self->{soap}{uri} or return;
+ my $proxy = $self->{soap}{proxy} or return;
+
+ return $self->{soap}{cache} if $self->{soap}{cache};
+
+ require HTTP::Cookies;
+ require SOAP::Lite;
+
+ my $cookies = HTTP::Cookies->new;
+
+ if ($self->{logtoken}) {
+ $cookies->set_cookie(0, user => $self->{logtoken}, '/', $self->{host});
+
+ } elsif ($self->{uid} && $self->{pass}) {
+ my $cookie = bakeUserCookie($self->{uid}, $self->{pass});
+ $cookies->set_cookie(0, user => $cookie, '/', $self->{host});
+
+ } else {
+ my $cookie_file = $self->{cookie_file} || find_cookie_file();
+ if ($cookie_file) {
+ $cookies = HTTP::Cookies::Netscape->new;
+ $cookies->load($cookie_file);
+ }
+ }
+
+ my $soap = SOAP::Lite->uri($uri)->proxy($proxy, cookie_jar => $cookies);
+ $self->{soap}{cache} = $soap;
+ return $soap;
+}
+
+
+sub find_cookie_file {
+ my $app = shift || 'Firefox';
+ my $file;
+ if ($^O eq 'MacOS' || $^O eq 'darwin') {
+ require Mac::Files;
+ Mac::Files->import(':DEFAULT');
+
+ my($dir, $vref, $type);
+ if ($^O eq 'darwin') {
+ $vref = &kUserDomain;
+ if ($app eq 'Chimera' || $app eq 'Firefox') {
+ $type = &kApplicationSupportFolderType;
+ } elsif ($app eq 'Mozilla') {
+ $type = &kDomainLibraryFolderType;
+ }
+ } elsif ($^O eq 'MacOS') {
+ $vref = &kOnSystemDisk;
+ $type = &kDocumentsFolderType;
+ }
+
+ $dir = FindFolder($vref, $type, &kDontCreateFolder);
+ $dir = catdir($dir, $app, 'Profiles');
+ for (0, 1) {
+ last if -e catfile($dir, 'cookies.txt');
+ opendir(my $dh, $dir) or die "Can't open $dir: $!";
+ $dir = catdir($dir, (grep !/^\./, readdir($dh))[0]);
+ closedir($dh);
+ }
+ $file = catfile($dir, 'cookies.txt');
+ }
+ return $file;
+}
+
+sub bakeUserCookie {
+ my($uid, $pass) = @_;
+ my $cookie = $uid . '::' . md5_hex($pass);
+ $cookie =~ s/(.)/sprintf("%%%02x", ord($1))/ge;
+ $cookie =~ s/%/%25/g;
+ return $cookie;
+}
+
+sub literal {
+ my($str) = @_;
+ $str =~ s/&/&/g;
+ $str =~ s/</&lt;/og;
+ $str =~ s/>/&gt;/og;
+ return $str;
+}
+
+sub fixparam {
+ my($str) = @_;
+ $str =~ s/([^$URI::unreserved])/$URI::Escape::escapes{$1}/og;
+ return $str;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Slash::Client - Write clients for Slash
+
+=head1 SYNOPSIS
+
+ my $client = Slash::Client::Journal->new({
+ host => 'use.perl.org',
+ });
+ my $entry = $client->get_entry(10_000);
+
+=head1 DESCRIPTION
+
+Slash::Client allows writing clients to access Slash. So far, only one
+client is implemented: accessing journals, which is done via SOAP. See
+L<Slash::Client::Journal> for more information.
+
+=head2 Constructor
+
+You create an object with the C<new> constructor, which takes a hashref
+of options.
+
+=over 4
+
+=item host
+
+The Slash site's host name.
+
+=item ssl
+
+Boolean, true if the Slash site can be accessed via SSL.
+
+=item uid
+
+=item pass
+
+If uid and pass have true values, they are used to construct the cookie
+for authentication purposes. See L<Authentication>.
+
+=item logtoken
+
+Logtoken is used for the cookie if it is passed.
+
+=item cookie_file
+
+Path to the file in Netscape format containing a cookie.
+
+=back
+
+=head2 Authentication
+
+Some methods require authentication; others may require authentication,
+depending on the site.
+
+There are three ways to authenticate. The first that's tried is uid/pass.
+If those are not supplied, logtoken is used: this is the value actually
+stored in the browser cookie (and used in the query string for some
+user-authenticated feed URLS). The third is to just try to load the cookie
+from a cookie file, either passing in a path in cookie_file, or trying to
+find the file automatically.
+
+I've only tested the cookie authentication recently with Firefox on Mac OS X.
+Feel free to submit patches for other browsers and platforms.
+
+If the given authentication method fails, others are not attempted, and the
+method will attempt to execute anyway.
+
+
+=head1 TODO
+
+Work on error handling.
+
+Other platforms for finding/reading cookies.
+
+
+=head1 SEE ALSO
+
+Slash::Client::Journal(3).
+
+
+=head1 VERSION
+
+$Id$
View
189 Slash/Client/lib/Slash/Client/Journal.pm
@@ -0,0 +1,189 @@
+# This code is a part of Slash, and is released under the GPL.
+# Copyright 1997-2005 by Open Source Technology Group. See README
+# and COPYING for more information, or see http://slashcode.com/.
+# $Id$
+
+package Slash::Client::Journal;
+
+use strict;
+use warnings;
+
+use base 'Slash::Client';
+
+our $VERSION = 0.01;
+
+sub new {
+ my($class, $opts) = @_;
+
+ my $self = $class->SUPER::new($opts);
+ $self->{soap}{uri} = "$self->{http}://$self->{host}/Slash/Journal/SOAP";
+ $self->{soap}{proxy} = "$self->{http}://$self->{host}/journal.pl";
+
+ return $self;
+}
+
+sub _return_from_entry {
+ my($self, $id, $list) = @_;
+
+ if ($list) {
+ my $entry = $self->get_entry($id);
+ return($id, $entry->{url}) if $entry && $entry->{url};
+ } else {
+ return $id;
+ }
+
+ return;
+}
+
+sub add_entry {
+ my($self, $data) = @_;
+
+ $data->{body} =~ s/\n/\012/g; # Local to Unix newlines, JIC
+
+ my $id = 0;
+ if ($data->{subject} && $data->{body}) {
+ $id = $self->soap->add_entry($data)->result;
+ }
+
+ return $self->_return_from_entry($id, wantarray());
+}
+
+sub modify_entry {
+ my($self, $id, $data) = @_;
+
+ $data->{body} =~ s/\n/\012/g; # Local to Unix newlines, JIC
+
+ my $newid = 0;
+ if ($data->{subject} && $data->{body} && $id) {
+ $newid = $self->soap->modify_entry($id, $data)->result;
+ }
+
+ return $self->_return_from_entry($id, wantarray());
+}
+
+sub delete_entry {
+ my($self, $id) = @_;
+
+ return $self->soap->delete_entry($id)->result;
+}
+
+sub get_entry {
+ my($self, $id) = @_;
+
+ return $self->soap->get_entry($id)->result;
+}
+
+sub get_entries {
+ my($self, $uid, $limit) = @_;
+
+ return $self->soap->get_entries($uid, $limit)->result;
+}
+
+1;
+
+# http://use.perl.org/~pudge/journal/3294
+
+__END__
+
+=head1 NAME
+
+Slash::Client::Journal - Write journal clients for Slash
+
+=head1 SYNOPSIS
+
+ my $client = Slash::Client::Journal->new({
+ host => 'use.perl.org',
+ });
+ my $entry = $client->get_entry(10_000);
+
+=head1 DESCRIPTION
+
+Slash::Client::Journal provides an API for writing clients for Slash journals.
+
+See L<Slash::Client> for details on authentication and for more information.
+
+=head2 Methods
+
+=over 4
+
+=item add_entry(HASHREF)
+
+Add an entry. Must be authenticated.
+
+Pass key-value pairs for C<subject> and C<body> (both required). Other optional
+keys are C<discuss>, C<posttype>, and C<tid>.
+
+C<discuss> is a boolean for turning on discussions. If false, comments
+are not turned on. If true, the user's prefs on the site are used (which
+is also the default).
+
+C<posttype> is an integer defining the post types. This is subject to change,
+but is currently: 1 = Plain Old Text, 2 = HTML Formatted,
+3 = Extrans (html tags to text), 4 = Code. Again, default is to simply use
+the user's preferences.
+
+C<tid> is a topic ID. This varies widely between Slash sites. To get a list,
+view the source of the journal editing page and look for the "tid" form values.
+
+In scalar context, returns the unique ID of the new entry, or false if failure.
+
+In list context, on success, returns the URL to the new journal entry as
+the second list element.
+
+
+=item modify_entry(ID, HASHREF)
+
+Modify an existing entry. Must be authenticated.
+
+Parameters are just like C<add_entry>. (Note: C<discuss> cannot be modified
+if a discussion had already been created for the entry.)
+
+In scalar context, returns the unique ID of the modified entry, or false if
+failure.
+
+In list context, on success, returns the URL to the modified journal entry as
+the second list element.
+
+
+=item delete_entry(ID)
+
+Deletes an existing entry. Must be authenticated.
+
+Returns true on success, false on error.
+
+
+=item get_entries(UID [, LIMIT])
+
+Gets the entries for a given user. If LIMIT is not supplied, a site-defined
+LIMIT is used.
+
+Returns an arrayref of hashrefs, where each hashref is an entry, with the keys
+being the entry's id, URL, and subject.
+
+Returns false on error.
+
+
+=item get_entry(ID)
+
+Get an entry. Returns lots of information about the entry, including uid,
+nickname, date, subject, discussion ID, tid, body, URL, id, posttype,
+and discussion URL.
+
+Returns false on error.
+
+=back
+
+
+=head1 TODO
+
+Work on error handling.
+
+
+=head1 SEE ALSO
+
+Slash::Client(3).
+
+
+=head1 VERSION
+
+$Id$
View
3 Slash/Client/t/journal.t
@@ -24,7 +24,8 @@ my %checks = (
my $client = Slash::Client::Journal->new({
host => $host,
uid => '-', # NOTE: setting uid/pass to bad values ensures
- pass => '-' # we don't get logged in, which is what we want
+ pass => '-' # we don't get logged in, which is what we want,
+ # to ensure we don't delete anything by accident
});
ok($client, 'Create object');

0 comments on commit c389524

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