source: genapp/etc/bp/perl @ 521

Last change on this file since 521 was 521, checked in by ehb, 7 years ago

specproj bugfix for lrfile and other windowing
atomicstructure jsmoladd
better perl bp

File size: 1.8 KB
Line 
1#!/usr/bin/perl
2
3# user defines
4
5# uncomment below to create a logfile
6$save_in_log = "/tmp/__moduleid__.log";
7
8# uncomment below to enable messaging
9# $enable_msg = 1;
10
11use JSON;
12
13if ( !@ARGV )
14{
15    print "\{\"error\":\"__moduleid__ called with no arguments\"\}\n";
16    exit;
17}
18
19$ref = decode_json( shift );
20
21## messaging setup
22
23sub sendmsg {};
24
25if ( $enable_msg ) {
26
27    use IO::Socket;
28
29    my $domsg = $$ref{ "_uuid" } && $$ref{ "_udpport" } && $$ref{ "_udphost" };
30
31    my $sock;
32    $sock = IO::Socket::INET->new( Proto => 'udp', PeerPort => $$ref{ "_udpport" }, PeerAddr => $$ref{ "_udphost" } ) if $domsg;
33
34    sub sendmsg {
35        return if !$domsg;
36        my $text = $_[0];
37        my $prog = $_[1];
38        print "sendmsg: $prog $text\n" if $debug;
39
40        if ( length( $text ) || length( $prog ) ) {
41            my $msg  = {};
42            $$msg{ "_uuid" } = $$ref{ "_uuid" };
43            $$msg{ "_textarea" } = $text if length( $text );
44            $$msg{ "_progress" } = $prog if length( $prog );
45            $sock->send( encode_json( $msg ) );
46        }
47    }
48}
49
50
51## format inputs for replacement
52sub formatinput {
53    my $x    = $_[0];
54    my $dec  = $_[1];
55    my $mlen = $_[2];
56    my $fmt  = "\%.${mlen}f";
57    my $out  = sprintf( $fmt, $x );
58    $out = substr( $out, 0, $mlen );
59    $out .= '0'x( $mlen - length( $out ) );
60    $out;
61}
62
63$res = {};
64
65# assemble output
66
67$$res{ "note" } = "__moduleid__ executable";
68
69
70if ( length( $save_in_log ) ) {
71    use Data::Dumper;
72
73    open OUT, ">>$save_in_log";
74    print OUT "-"x20 . "\n";
75    print OUT `date`;
76    print OUT "$0\n";
77    print OUT "--- input ---\n";
78    print OUT Dumper($ref);
79    print OUT "--- output ---\n";
80    print OUT Dumper($res);
81    print OUT "-"x20 . "\n";
82    close OUT;
83}
84
85print encode_json( $res ) . "\n";
86
Note: See TracBrowser for help on using the repository browser.