source: other-projects/diy-streetview-pano-capture/trunk/Server/capture.pm@ 26882

#!/usr/bin/perl -w
use warnings;
use strict;
use Cwd;
use Sys::Hostname;
use IO::Socket;

package main;
{
    my (%console, @upstart, $active, $server);
    local (%main::settings, %main::plugins, $main::socket);
    my $port = $ARGV[0] || '51234';
    $active = 1;
    $|=1;

    #Intro Blurb
    print "DIY Streetview Panorama capturer\nMade by: Joshua 'Boboon' Holland <http://www.theboboon.com>\nFor The University Of Waikato <http://www.cs.waikato.ac.nz>\nMany caffeinated beverages were harmed in the making of this software.\n-------------------------------\n";
    #Just a Dash of awesomeness.
    #Start the app
    print "Loading plugins...\n";
    &loadplugins;
    print "Loading Console...\n";
    &initconsole;
    print "Doing Console Pre Execution Jobs...\n";
    &runupstart;
    $server = new IO::Socket::INET(LocalPort=>$port, Proto=>'tcp', Timeout=>20, Listen=>1, Reuse => 1) or die "Could not create socket: $!\n"; #Clients have 20 seconds to connect. Should be plenty of time, since Android devices die after 15 seconds.
    setsockopt($server, SOL_SOCKET, SO_RCVTIMEO, pack('L!L!', +1800 ,0)); #Sometimes packet loss, and devices abnormally dying, will cause a server "Hang", now all connections are culled after 30 minutes of idling.
    print "Started Command server on $port\n";
    while ($active)
    {
    $main::socket = $server->accept();
        if (defined $main::socket)
        {
            my $ip = $main::socket->peerhost();
            print "Remote Client connected from: $ip\n";
            &console;
            print "Client $ip disconnected.\n";
        }
    }

    sub console
    {
        print "Console Loaded.\n";
        while ($active == 1 && (my $in_line = <$main::socket>))
            {
                $in_line = lc($in_line);
                my (@input);
                $in_line =~ s/\r?\n$//;
                print "[", $main::socket->peerhost(), "] CMD: '$in_line'\n";
                if (!defined($in_line) || !length($in_line))
                {
                
                }
                else
                {
                    @input = split(/\s?:/, $in_line);
                    my $cmd = shift(@input);
                    if ($cmd eq "help")
                    {
                        print $main::socket "Commands:\n";
                        while (my ($key, $value) = each(%console))
                        {
                            my $help = $value->help;
                            print $main::socket "'$key' is used to $help\n";
                        }
                        print $main::socket "'help' is used to show *This* prompt\n'exit' is used to generate a portal to Equestria. Jokes, it exits the application\n";
                        print $main::socket "Commands are not case sensitive\n";
                    }
                    elsif ($cmd eq "exit")
                    {
                    $active = 0;
                    close($main::socket);
                    print "Caught SIGEXIT. Shutting down server...\n";
                    }
                    elsif ($cmd eq "comms check")
                    {
                        print $main::socket "HELO\n"; #Allows Android devices to check if the connection works... A kind of "Handshake"
                    }
                    elsif (!$console{$cmd})
                    {
                        print $main::socket "Unknown command '$cmd'. It you need help type 'help' for a help prompt.\n";
                    }
                    else
                    {
                        $in_line =~ s/$cmd\s?:\s?//;
                        $console{$cmd}->do($in_line);
                    }
                }
            }
    }

    sub initconsole
    {
        undef(%console);
        my ($DIR, @files);
        my $count_files = 0;
        opendir ($DIR, "classes/console");
        @files = grep(m/.*\.pm$/, readdir($DIR));
        while (scalar(@files) > 0)
            {
               my $file = shift(@files);
               require("classes/console/$file");
               my $class = $file;
               $class =~ s/\.pm//g;
               my $obj = new $class();
               $main::settings{lc($obj->command)} = $obj->defaultsettings;
               $console{lc($obj->command)} = $obj;
               if ($obj->doupstart())
                    {
                        push (@upstart, $obj)
                    }
            }
            closedir ($DIR);
            print "Console initialized.\n"
    }

    sub loadplugins
    {
        undef(%main::plugins);
        my ($DIR, @files);
        my $count_files = 0;
        opendir ($DIR, "classes/plugins");
        @files = grep(m/.*\.pm$/, readdir($DIR));
        while (scalar(@files) > 0)
            {
               my $file = shift(@files);
               require("classes/plugins/$file");
               my $class = $file;
               $class =~ s/\.pm//g;
               my $obj = new $class();
               $main::plugins{lc($obj->name)} = $obj;
               $main::settings{lc($obj->name)} = $obj->defaultsettings;
               if ($obj->doupstart())
                    {
                        push (@upstart, $obj)
                    }
               print "Loaded Plugin '",$obj->name,"'...\n";
            }
            closedir ($DIR);
            print "All plugins loaded.\n";
    }

    sub runupstart
        {
            my $count_upstart = 0;
            while ($count_upstart < scalar(@upstart))
                {
                    $upstart[$count_upstart]->upstart;
                    $count_upstart++;
                }
            print "$count_upstart upstart jobs run.\n";
            undef(@upstart); #It's never used again, and RAM is probably not all that large.
        }
}