root/trunk/hotstuff/dxs/DXS.pm

Revision 455, 13.4 KB (checked in by josef, 4 years ago)

- do away with hack which always forced the id for comments to be zero
Line 
1#!/usr/bin/perl
2#
3# Backend module for the DXS web service handler: Get Hot New Stuff
4# Copyright (C) 2005 - 2007 Josef Spillner <josef@kstuff.org>
5# Published under 'GNU AGPLv3 or later' conditions
6
7package DXS;
8
9use strict;
10use Data::Dumper;
11use MIME::Base64;
12use SOAP::Lite;
13use DBI;
14
15my $version = "0.9.3";
16
17my $default_config = "/etc/hotstuff.conf";
18
19my $opt_config = $default_config;
20
21# FIXME: This is not clean. But SOAP::Lite doesn't really seem to
22# work together with CGI.
23my $site = $ENV{"REQUEST_URI"};
24$site =~ s/.*site=([^+]*).*/\1/;
25if($site ne ""){
26        $opt_config = "/etc/hotstuff.d/$site.conf";
27}
28
29use vars qw($dbhost $dbname $dbuser $dbpass);
30use vars qw($uploaddir);
31use vars qw($baseurl $providername $accessurl);
32eval{require $opt_config};
33if($@){
34        print "Configuration file $opt_config not found or invalid.\n";
35        exit 1;
36}
37
38use vars qw(@ISA);
39@ISA = qw(Exporter SOAP::Server::Parameters);
40
41sub xmlq{
42        my $s = shift(@_);
43
44        $s =~ s/&/&amp;/g;
45
46        return $s;
47}
48
49sub GHNSUpload{
50        my ($self, @args) = @_;
51        my $envelope = pop @args;
52
53        my $author = $envelope->valueof("//GHNSUpload/author");
54        my $version = $envelope->valueof("//GHNSUpload/version");
55        my $release = $envelope->valueof("//GHNSUpload/release");
56        my $licence = $envelope->valueof("//GHNSUpload/licence");
57        my $name = $envelope->valueof("//GHNSUpload/name");
58        my $category = $envelope->valueof("//GHNSUpload/category");
59        my $summary = $envelope->valueof("//GHNSUpload/summary");
60        my $payload = $envelope->valueof("//GHNSUpload/payload");
61        my $preview = $envelope->valueof("//GHNSUpload/preview");
62
63        my $ret = "failure";
64
65        if(($author) and ($version) and ($name) and ($category)){
66                if(($summary) and ($payload)){
67                        mkdir $uploaddir, 0777;
68                        if($preview){
69                                open(FILE, ">$uploaddir/tmp.preview.png");
70                                print FILE MIME::Base64::decode_base64($preview);
71                                close(FILE);
72                        }
73                        open(FILE, ">$uploaddir/tmp.payload.png");
74                        print FILE MIME::Base64::decode_base64($payload);
75                        close(FILE);
76                        open(FILE, ">$uploaddir/tmp.meta");
77                        print FILE "<?xml version='1.0'?>\n";
78                        print FILE "<ghnsupload>\n";
79                        print FILE "<stuff category='$category'>\n";
80                        print FILE "<author email=''>$author</author>\n";
81                        print FILE "<version>$version</version>\n";
82                        print FILE "<release>$release</release>\n";
83                        print FILE "<licence>$licence</licence>\n";
84                        print FILE "<name>$name</name>\n";
85                        print FILE "<summary>$summary</summary>\n";
86                        if($preview){
87                                print FILE "<preview>tmp.preview.png</preview>\n";
88                        }else{
89                                print FILE "<preview></preview>\n";
90                        }
91                        print FILE "<payload>tmp.payload.png</payload>\n";
92                        print FILE "</stuff>\n";
93                        print FILE "</ghnsupload>\n";
94                        print FILE "\n";
95                        close(FILE);
96
97                        $ret = "success";
98                }
99        }
100
101        return SOAP::Data->value($ret);
102}
103
104sub GHNSInfo{
105        my $server = SOAP::Data->name("server" => "Desktop Exchange Service (DXS)");
106        my $version = SOAP::Data->name("version" => "$version");
107        my $provider = SOAP::Data->name("provider" => "$providername");
108        my $url = SOAP::Data->name("url" => "$baseurl");
109
110        my @fields;
111        push @fields, $server;
112        push @fields, $version;
113        push @fields, $provider;
114        push @fields, $url;
115
116        return SOAP::Data->value(@fields);
117}
118
119sub GHNSCategories{
120        my ($self, @args) = @_;
121        my $envelope = pop @args;
122
123        my @categories;
124        my ($category, $icon, $meta_ref);
125        my ($name, $description);
126
127        my $conn = DBI->connect("DBI:Pg:host=$dbhost;dbname=$dbname;user=$dbuser;password=$dbpass");
128        $conn || die DBI->errstr;
129
130        my $res = $conn->prepare("SELECT DISTINCT directory.category, " .
131                "categories.icon, categories.meta_ref " .
132                "FROM directory LEFT OUTER JOIN categories " .
133                "ON categories.category = directory.category");
134        $res->execute();
135        $res->bind_columns(\$category, \$icon, \$meta_ref);
136        while($res->fetch()){
137                $name = "";
138                $description = "";
139
140                if($meta_ref){
141                        my $res2 = $conn->prepare("SELECT content FROM categorycontents " .
142                                "WHERE index = $meta_ref AND type = 'name'");
143                        $res2->execute();
144                        $res2->bind_columns(\$name);
145                        $res2->fetch();
146                        my $res2 = $conn->prepare("SELECT content FROM categorycontents " .
147                                "WHERE index = $meta_ref AND type = 'description'");
148                        $res2->execute();
149                        $res2->bind_columns(\$description);
150                        $res2->fetch();
151                }
152
153                if($name eq ""){
154                        $name = $category;
155                }
156
157                my $categorytag = SOAP::Data->name("category" => $category);
158                my $nametag = SOAP::Data->name("name" => $name);
159                my $descriptiontag = SOAP::Data->name("description" => $description);
160                my $icontag;
161                if($icon ne ""){
162                        $icontag = SOAP::Data->name("icon" => $icon);
163                }
164
165                my @categoryfields;
166                push @categoryfields, $categorytag;
167                push @categoryfields, $nametag;
168                push @categoryfields, $descriptiontag;
169                if($icon ne ""){
170                        push @categoryfields, $icontag;
171                }
172
173                my $categorytag = SOAP::Data->name("category" => \SOAP::Data->value(@categoryfields));
174                push @categories, $categorytag;
175        }
176        $res->finish();
177
178        my $response = SOAP::Data->value(@categories);
179        return $response;
180}
181
182sub GHNSComments{
183        my ($self, @args) = @_;
184        my $envelope = pop @args;
185        my @comments;
186        my $comment;
187
188        my $id = $envelope->valueof("//GHNSComments/id");
189
190        my $conn = DBI->connect("DBI:Pg:host=$dbhost;dbname=$dbname;user=$dbuser;password=$dbpass");
191        $conn || die DBI->errstr;
192
193        my $res = $conn->prepare("SELECT comment FROM comments WHERE id = $id");
194        $res->execute();
195        $res->bind_columns(\$comment);
196        while($res->fetch()){
197                my $com = SOAP::Data->name("comments" => $comment);
198                @comments = (@comments, $com);
199        }
200        $res->finish();
201
202        return SOAP::Data->value(@comments);
203}
204
205sub GHNSList{
206        my ($self, @args) = @_;
207        my $envelope = pop @args;
208        my ($id, $entryname, $author, $version, $release, $releasedate, $rating, $downloads);
209        my ($category, $licence);
210        my $meta_ref;
211        my ($preview, $payload, $summary, $name);
212        my @entries;
213
214        my $category = $envelope->valueof("//GHNSList/category");
215        my $feed = $envelope->valueof("//GHNSList/feed");
216
217        my $conn = DBI->connect("DBI:Pg:host=$dbhost;dbname=$dbname;user=$dbuser;password=$dbpass");
218        $conn || die DBI->errstr;
219
220        my $query = "SELECT id, name, author, version, release, releasedate, " .
221                "rating, downloads, category, licence, meta_ref " .
222                "FROM directory WHERE (validity IS NULL OR validity = '')";
223        if($category ne ""){
224                $query = "$query AND category = '$category'";
225        }
226        if($feed ne ""){
227                if($feed eq "latest"){
228                        $query = "$query ORDER BY releasedate DESC";
229                }elsif($feed eq "score"){
230                        $query = "$query ORDER BY rating DESC";
231                }elsif($feed eq "downloads"){
232                        $query = "$query ORDER BY downloads DESC";
233                }elsif($feed eq "subscription"){
234                        $query = "$query JOIN subscriptions ON directory.id = subscriptions.id " .
235                                "WHERE subscriptions.username = ''";
236                }
237        }
238        my $res = $conn->prepare($query);
239        $res->execute();
240
241        $res->bind_columns(\$id, \$entryname, \$author, \$version, \$release, \$releasedate,
242                \$rating, \$downloads, \$category, \$licence,
243                \$meta_ref);
244        while($res->fetch()){
245                my $res2;
246
247                $name = "";
248                $summary = "";
249                $preview = "";
250                $payload = "";
251
252                $res2 = $conn->prepare("SELECT content FROM contents " .
253                        "WHERE index = $meta_ref AND type = 'preview'");
254                $res2->execute();
255                $res2->bind_columns(\$preview);
256                $res2->fetch();
257                $res2 = $conn->prepare("SELECT content FROM contents " .
258                        "WHERE index = $meta_ref AND type = 'payload'");
259                $res2->execute();
260                $res2->bind_columns(\$payload);
261                $res2->fetch();
262                $res2 = $conn->prepare("SELECT content FROM contents " .
263                        "WHERE index = $meta_ref AND type = 'summary'");
264                $res2->execute();
265                $res2->bind_columns(\$summary);
266                $res2->fetch();
267                $res2 = $conn->prepare("SELECT content FROM contents " .
268                        "WHERE index = $meta_ref AND type = 'name'");
269                $res2->execute();
270                $res2->bind_columns(\$name);
271                $res2->fetch();
272
273                if($name eq ""){
274                        $name = $entryname;
275                }
276
277                my $previewurl;
278                my $payloadurl;
279
280                if($accessurl ne ""){
281                        if($site ne ""){
282                                $previewurl = "$accessurl?file=$preview&site=$site";
283                                $payloadurl = "$accessurl?file=$payload&site=$site";
284                        }else{
285                                $previewurl = "$accessurl?file=$preview";
286                                $payloadurl = "$accessurl?file=$payload";
287                        }
288                }else{
289                        $previewurl = "$baseurl/$preview";
290                        $payloadurl = "$baseurl/$payload";
291                }
292
293                my $idtag = SOAP::Data->name("id" => $id);
294                my $nametag = SOAP::Data->name("name" => $name);
295                my $authortag = SOAP::Data->name("author" => $author);
296                my $versiontag = SOAP::Data->name("version" => $version);
297                my $releasetag = SOAP::Data->name("release" => $release);
298                my $releasedatetag = SOAP::Data->name("releasedate" => $releasedate);
299                my $ratingtag = SOAP::Data->name("rating" => $rating);
300                my $downloadstag = SOAP::Data->name("downloads" => $downloads);
301                my $categorytag = SOAP::Data->name("category" => $category);
302                my $licencetag = SOAP::Data->name("licence" => $licence);
303                my $previewtag = SOAP::Data->name("preview" => xmlq($previewurl));
304                my $payloadtag = SOAP::Data->name("payload" => xmlq($payloadurl));
305                my $summarytag = SOAP::Data->name("summary" => $summary);
306
307                my @fields;
308                push @fields, $idtag;
309                push @fields, $nametag;
310                push @fields, $authortag;
311                push @fields, $versiontag;
312                push @fields, $releasetag;
313                push @fields, $releasedatetag;
314                push @fields, $ratingtag;
315                push @fields, $downloadstag;
316                push @fields, $categorytag;
317                push @fields, $licencetag;
318                if($preview ne ""){
319                        push @fields, $previewtag;
320                }
321                push @fields, $payloadtag;
322                push @fields, $summarytag;
323
324                my $entrytag = SOAP::Data->name("entry" => \SOAP::Data->value(@fields));
325                push @entries, $entrytag;
326        }
327        $res->finish();
328
329        my $notapproved;
330
331        $query = "SELECT COUNT(*) " .
332                "FROM directory WHERE validity IS NOT NULL AND validity <> ''";
333        $res = $conn->prepare($query);
334        $res->execute();
335        $res->bind_columns(\$notapproved);
336        $res->fetch();
337        $res->finish();
338
339        my $xmlresponse = SOAP::Data->name("entries")->value(\@entries);
340        $xmlresponse = $xmlresponse->attr({notapproved => $notapproved});
341
342        return $xmlresponse;
343}
344
345sub GHNSHistory{
346        my ($self, @args) = @_;
347        my $envelope = pop @args;
348        my ($id);
349        my ($previous);
350        my @entries;
351
352        my $id = $envelope->valueof("//GHNSHistory/id");
353
354        my $conn = DBI->connect("DBI:Pg:host=$dbhost;dbname=$dbname;user=$dbuser;password=$dbpass");
355        $conn || die DBI->errstr;
356
357        my $res = $conn->prepare("SELECT previous FROM versions WHERE version = '$id'");
358        $res->execute();
359        $res->bind_columns(\$previous);
360        while($res->fetch()){
361                foreach my $version(split(/,/, $previous)){
362                        my $idtag = SOAP::Data->name("id" => $version);
363
364                        my $entrytag = SOAP::Data->name("entry" => \SOAP::Data->value(
365                                ($idtag)));
366                        @entries = (@entries, $entrytag);
367                }
368        }
369        $res->finish();
370
371        return SOAP::Data->value(@entries);
372}
373
374sub GHNSChanges{
375        my ($self, @args) = @_;
376        my $envelope = pop @args;
377        my ($id);
378        my ($previous, $changelog);
379        my @entries;
380
381        my $id = $envelope->valueof("//GHNSChanges/id");
382
383        my $conn = DBI->connect("DBI:Pg:host=$dbhost;dbname=$dbname;user=$dbuser;password=$dbpass");
384        $conn || die DBI->errstr;
385
386        my $res = $conn->prepare("SELECT previous FROM versions WHERE version = '$id'");
387        $res->execute();
388        $res->bind_columns(\$previous);
389        while($res->fetch()){
390                foreach my $version(split(/,/, $previous)){
391                        my $res2 = $conn->prepare("SELECT content FROM contents " .
392                                "WHERE index = $version AND type = 'changes'");
393                        $res2->execute();
394                        $res2->bind_columns(\$changelog);
395                        if($res2->fetch()){
396                                my $versiontag = SOAP::Data->name("version" => $version);
397                                my $changetag = SOAP::Data->name("changelog" => $changelog);
398
399                                my $entrytag = SOAP::Data->name("entry" => \SOAP::Data->value(
400                                        ($changetag, $versiontag)));
401                                @entries = (@entries, $entrytag);
402                        }
403                        $res2->finish();
404                }
405        }
406        $res->finish();
407
408        return SOAP::Data->value(@entries);
409}
410
411sub GHNSRating{
412        my ($self, @args) = @_;
413        my $envelope = pop @args;
414        my ($vote);
415
416        my $id = $envelope->valueof("//GHNSRating/id");
417        my $rating = $envelope->valueof("//GHNSRating/rating");
418
419        my $conn = DBI->connect("DBI:Pg:host=$dbhost;dbname=$dbname;user=$dbuser;password=$dbpass");
420        $conn || die DBI->errstr;
421
422        my $res = $conn->prepare("INSERT INTO ratings " .
423                "(id, vote) VALUES " .
424                "($id, $rating)");
425        $res->execute();
426
427        my $res = $conn->prepare("SELECT AVG(vote) FROM ratings WHERE id = $id");
428        $res->execute();
429        $res->bind_columns(\$vote);
430        if($res->fetch()){
431                return int($vote);
432        }
433
434        return SOAP::Data->value("???");
435}
436
437sub GHNSComment{
438        my ($self, @args) = @_;
439        my $envelope = pop @args;
440
441        my $id = $envelope->valueof("//GHNSComment/id");
442        my $comment = $envelope->valueof("//GHNSComment/comment");
443
444        my $conn = DBI->connect("DBI:Pg:host=$dbhost;dbname=$dbname;user=$dbuser;password=$dbpass");
445        $conn || die DBI->errstr;
446
447        my $res = $conn->prepare("INSERT INTO comments " .
448                "(id, comment) VALUES " .
449                "($id, '$comment')");
450        $res->execute();
451
452        return SOAP::Data->value("ok");
453}
454
455sub GHNSRemoval{
456        my ($self, @args) = @_;
457        my $envelope = pop @args;
458
459        my $id = $envelope->valueof("//GHNSRemoval/id");
460
461        my $conn = DBI->connect("DBI:Pg:host=$dbhost;dbname=$dbname;user=$dbuser;password=$dbpass");
462        $conn || die DBI->errstr;
463
464        my $res = $conn->prepare("INSERT INTO removals " .
465                "(id, username) VALUES " .
466                "($id, '')");
467        $res->execute();
468
469        return SOAP::Data->value("ok");
470}
471
472sub GHNSSubscription{
473        my ($self, @args) = @_;
474        my $envelope = pop @args;
475
476        my $id = $envelope->valueof("//GHNSSubscription/id");
477        my $subscribe = $envelope->valueof("//GHNSSubscription/subscribe");
478
479        my $conn = DBI->connect("DBI:Pg:host=$dbhost;dbname=$dbname;user=$dbuser;password=$dbpass");
480        $conn || die DBI->errstr;
481
482        if($subscribe eq "true"){
483                my $res = $conn->prepare("INSERT INTO subscriptions " .
484                        "(id, username) VALUES " .
485                        "($id, '')");
486                $res->execute();
487        }else{
488                my $res = $conn->prepare("DELETE FROM subscriptions " .
489                        "WHERE id = $id AND username = ''");
490                $res->execute();
491        }
492
493        return SOAP::Data->value("ok");
494}
495
4961;
Note: See TracBrowser for help on using the browser.