Difference between revisions of "Rp"
From Organic Design wiki
m |
m |
||
(2 intermediate revisions by 2 users not shown) | |||
Line 1: | Line 1: | ||
+ | {{legacy}}{{lowercase}} | ||
+ | <source lang="perl"> | ||
#!/usr/bin/perl | #!/usr/bin/perl | ||
# [[[[http://www.organicdesign.co.nz/peerd|peerd]]]] - nodal p2p wiki daemon | # [[[[http://www.organicdesign.co.nz/peerd|peerd]]]] - nodal p2p wiki daemon | ||
Line 122: | Line 124: | ||
print qx($ps); | print qx($ps); | ||
} | } | ||
+ | </source> | ||
+ | [[Category:PERL]] |
Latest revision as of 13:31, 2 August 2017
#!/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);
}