Difference between revisions of "Rp"

From Organic Design wiki
m
m
 
(35 intermediate revisions by 3 users not shown)
Line 1: Line 1:
 +
{{legacy}}{{lowercase}}
 +
<source lang="perl">
 
#!/usr/bin/perl
 
#!/usr/bin/perl
use HTTP::Request;
+
# [[[[http://www.organicdesign.co.nz/peerd|peerd]]]] - nodal p2p wiki daemon
use LWP::UserAgent;
+
# 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;
 
use Cwd;
 +
our $cwd = cwd;
 +
$ps = 'ps x';
  
# Get CWD and determine OS
+
# Try and use LWP otherwise fallback to curl
our $cwd = cwd;
+
eval 'use HTTP::Request';
our $ux = ($cwd =~ m/^\//);
+
$lwp = $@?0:1;
$ux ? $cwd = cwd : $cwd =~ s/\//\\/g;
+
eval 'use LWP::UserAgent';
$cwd =~ s/\//\\/g unless $cwd =~ m/^\//;
+
$lwp = 0 if $@;
$cwd =~ s/[\\\/]$//g;
+
$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)
 
# Command to list running peerd's (or null for Win32)
$ps = $ux ? 'ps lx|egrep peerd:' : '';
+
if ($ux) {
$qxps = qx($ps);
+
        $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;
 +
        }
  
# Set up a www-user-agent and source-url for syncing
+
# rp c
$wiki = "http://www.organicdesign.co.nz/wiki/index.php";
+
# - compiles without syncing any files
$client = LWP::UserAgent->new( cookie_jar => {} );
+
if ($ARGV[0] ne 'c') {
  
# Build sync-list from args, or if none, obtain list from Bender/fileSync article in OD wiki
+
        # Sync files specified in args, or obtain a list of files from Benders fileSync list
if ($#ARGV<0) {
+
        if ($#ARGV<0) {
print "\nRetrieving files specified in OD:Bender/fileSync list...\n";
+
                print "Retrieving files specified in OD:Bender/fileSync list...\n";
my $fileSync = $client->request(HTTP::Request->new(GET => "$wiki?title=Bender/fileSync&xpath:view:"));
+
                $fileSync = url("$wiki?title=Bender/fileSync&xpath:view:");
$fileSync = $fileSync->content;
+
                $fileSync =~ s/<\/ul>.+$//ms;
$fileSync =~ s/<\/ul>.+$//ms;
+
                %articles = $fileSync =~ /<li>.+?title="(.+?)">(.+?)<\/a>/g;
%articles = $fileSync =~ /<li>.+?title="(.+?)">(.+?)<\/a>/g;
+
                }
}
+
        else {
else {
+
                print "Retrieving files specified in command line args...\n";
print "\nRetrieving files specified in command line args...\n";
+
                $articles{$_} = "/home/peerd/$_" for @ARGV;
$articles{$_} = "/home/peerd/$_" for @ARGV;
+
                }
}
 
  
# Retrieve each article in sync-list and save to specified filepath
+
        # Retrieve each article in sync-list and save to specified filepath
for my $article (keys %articles) {
+
        for my $article (keys %articles) {
print "\t$article\n";
+
                print "\t$article\n";
if (open FH, '>', $ux ? $articles{$article} : "$cwd/$article") {
+
                if (open FH, '>', $ux ? $articles{$article} : "$cwd/$article") {
binmode FH;
+
                        binmode FH;
$article = $client->request(HTTP::Request->new(GET => "$wiki?title=$article&action=raw"))->content;
+
                        print FH url("$wiki?title=$article&action=raw")."\n";
print FH "$article\n";
+
                        close FH;
close FH;
+
                        }
}
+
                }
}
 
  
# Don't do any compilation unless ux
+
        }
exit unless $ux;
 
  
 
# Compile husk and format output
 
# Compile husk and format output
print "\nCompiling...\n";
+
print "\nCompiling...";
$err = qx( gcc -o /home/peerd/husk.bin /home/peerd/husk.c 2>&1 );
+
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/^In file.+?$//mg;
 
$err =~ s/^\s+from/\nfrom/mg;
 
$err =~ s/^\s+from/\nfrom/mg;
Line 59: Line 117:
 
if ($err) { print "$err\n\nAborting: There are errors or warnings!\nNothing killed or executed.\n\n" }
 
if ($err) { print "$err\n\nAborting: There are errors or warnings!\nNothing killed or executed.\n\n" }
 
else {
 
else {
print "\nCompiled successfully!\n";
+
        print "Compiled successfully!\n";
 
+
        # Kill running peers (kp) and start a new instance
# kill currently running instances of peerd
+
        kp;
if ($qxps) {
+
        print "Starting new instance now...\n\n";
print "Killing currently running peerd instances:\n";
+
        qx( /home/peerd/peerd.bin Gir port=2012 );
print $qxps;
+
        print qx($ps);
for (split /\n/, $qxps) { qx(kill $1) if /^.+?([0-9]{2,}).+?\d+:\d\d\s*(.+)/ }
+
        }
} else { print "Nothing to kill :-(\n" }
+
</source>
 
+
[[Category:PERL]]
print "Passing execution over now...\n\n";
 
qx( /home/peerd/husk.bin );
 
print qx($ps);
 
}
 

Latest revision as of 13:31, 2 August 2017

Legacy.svg 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, now this page is for historic record only.
#!/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);
        }