Rp

Legacy: This article describes a concept that has been superseded in the course of ongoing development on the Organic Design wiki. Please do not develop this any further or base work on this concept, this is only useful for a historic record of work done. You may find a link to the currently used concept or function in this article, if not you can contact the author to find out what has taken the place of this legacy item.

#!/usr/bin/perl
# [[[[http://www.organicdesign.co.nz/peerd|peerd]]]] - nodal p2p wiki daemon
# Syncronises, compiles and runs [[[[peerd.c]]]]
# This article and all its includes are licenced under LGPL
# GPL: [[[[http://www.gnu.org/copyleft/lesser.html]]]]
# SRC: [[[[http://www.organicdesign.co.nz/rp]]]]

# Determine OS
our $ux = ($^O eq 'linux');
our $darwin = ($^O eq 'darwin');
our $win32 = ($^O eq 'MSWin32');

print "\n";
use Cwd;
our $cwd = cwd;
$ps = 'ps x';

# Try and use LWP otherwise fallback to curl
eval 'use HTTP::Request';
$lwp = $@?0:1;
eval 'use LWP::UserAgent';
$lwp = 0 if $@;
$client = LWP::UserAgent->new( cookie_jar => {} ) if $lwp;
$wiki = "http://www.organicdesign.co.nz/wiki/index.php";
sub url {
        my $doc = shift;
        return qx(curl -s "$doc") unless $lwp;
        $doc = $client->request(HTTP::Request->new(GET=>$doc));
        return $doc->content;
        }

# Command to list running peerd's (or null for Win32)
if ($ux) {
        $qxps = [split /^/, qx($ps)]->[0].qx($ps|egrep peerd[:]); # adds column header
        $k = $#{[split /^/, $qxps]};
        $s = $k>1?'s':'';
        } else { $qxps = '' }

# sub to kill currently running instances of peerd
sub kp {
        if ($k) {
                for (split /^/, $qxps) { qx(kill -9 $1) if /^.*?([0-9]{2,}).+?\d+:\d\d\s*(.+)/ }
                print "\n$qxps$k instance$s killed.\n\n";
                } else { print "Nothing to kill :-(\n\n" }
        }

# rp k
# - kills currently running peerd's and exits
if ($ux and $ARGV[0] eq 'k') {
        kp;
        exit;
        }

# rp l
# - lists currently running peerd's and exits
if ($ux and $ARGV[0] eq 'l') {
        if ($k) { print ("$qxps$k instance$s of peerd running.\n\n") }
        else { print "There are no instances of peerd running.\n\n" }
        exit;
        }

# rp c
# - compiles without syncing any files
if ($ARGV[0] ne 'c') {

        # Sync files specified in args, or obtain a list of files from Benders fileSync list
        if ($#ARGV<0) {
                print "Retrieving files specified in OD:Bender/fileSync list...\n";
                $fileSync = url("$wiki?title=Bender/fileSync&xpath:view:");
                $fileSync =~ s/<\/ul>.+$//ms;
                %articles = $fileSync =~ /<li>.+?title="(.+?)">(.+?)<\/a>/g;
                }
        else {
                print "Retrieving files specified in command line args...\n";
                $articles{$_} = "/home/peerd/$_" for @ARGV;
                }

        # Retrieve each article in sync-list and save to specified filepath
        for my $article (keys %articles) {
                print "\t$article\n";
                if (open FH, '>', $ux ? $articles{$article} : "$cwd/$article") {
                        binmode FH;
                        print FH url("$wiki?title=$article&action=raw")."\n";
                        close FH;
                        }
                }

        }

# Compile husk and format output
print "\nCompiling...";
if ($darwin) {
    print " for darwin\n";
    $err = qx( gcc -I/Library/Frameworks/SDL.framework/Headers -I/Library/Frameworks/SDL_image.framework/Headers peerd.c SDLmain.m -framework SDL -framework SDL_image -framework Cocoa );
    }
elsif ($win32) {
    print " for win32/mingw\n";
    #$err = qx( gcc -I/usr/local/include -Os -D_GNU_SOURCE=1 -DHAVE_OPENGL -Dmain=SDL_main peerd.c -o peerd.o -L/usr/local/lib -lmingw32 -lws2_32 -ltre.dll -lSDLmain -lSDL -lSDL_image -lglu32 -lopengl32 -lglut -mwindows );
    }
elsif ($ux) {
    print " for linux\n";
    $err = qx( gcc -I/usr/include/SDL -lGL -lGLU -lSDL -lpthread -lSDL_image -o /home/peerd/peerd.bin /home/peerd/peerd.c );
    }
else { print " failed. Could not determine host system type.\n" }


$err =~ s/^In file.+?$//mg;
$err =~ s/^\s+from/\nfrom/mg;
$err =~ s/^/\t/mg;
$err =~ s/\/home\/peerd\///g;
$err =~ s/^\s+//g;
$err =~ s/\s+$//g;

# Execute compiled result if compiled without any problems
if ($err) { print "$err\n\nAborting: There are errors or warnings!\nNothing killed or executed.\n\n" }
else {
        print "Compiled successfully!\n";
        # Kill running peers (kp) and start a new instance
        kp;
        print "Starting new instance now...\n\n";
        qx( /home/peerd/peerd.bin Gir port=2012 );
        print qx($ps);
        }