source: genapp/etc/bp/perl @ 1732

Last change on this file since 1732 was 1598, checked in by ehb, 4 years ago

Updated genapp to latest genappalpha

File size: 3.6 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
11## end user defines
12
13{
14    if ( $] < 5.018 ) {
15        my $f = "/etc/profile.d/genapp.sh";
16        my $gb;
17        if ( -e $f ) {
18            my $fh;
19            !open $fh, $f || die "Error: the version of perl found is < 5.18 and, although there exists $f, the permissions do now allow reading by this process\n";
20            my @l = <$fh>;
21            close $fh;
22            @l = grep !/^\s*#/, @l;
23            @l = grep /GENAPP=/, @l;
24            grep chomp, @l;
25            die "Error: the version of perl found is < 5.18 and, although there exists $f, there is no definition of GENAPP available within it.\n" if !@l;
26            my $l = pop @l;
27            ( $gb ) = $l =~ /GENAPP=([^#;]+)/;
28            die "Error: the version of perl found is < 5.18 and, although there exists $f, the value of GENAPP within it could not be parsed.\n" if !$gb;
29            die "Error: the version of perl found is < 5.18 and, although there exists $f, the value of GENAPP within it ($gb) is not a directory.\n" if !-d $gb;
30        } else {
31            die "Error: the version of perl found is < 5.18 and $f does not exist\n";
32        }       
33        if ( -e "$gb/perl/bin/perl" ) {
34            $pv =`$gb/perl/bin/perl -e 'print \$];'`;
35            if ( $pv >= 5.018 ) {
36                unshift @ARGV, $0;
37                exec( "$gb/perl/bin/perl", @ARGV );
38            } else {
39                die "$gb/perl/bin/perl exists, but not a correct version of perl (needs a minimum of 5.18)\n";
40            }
41        } else {
42            die "you need to install a version of perl >= 5.18 in $gb/perl\n
43there is a script $gb/sbin/install-perl-stable to do this";
44        }
45    }
46}
47
48my $rc = eval {
49    require JSON;         JSON->import();
50};
51
52if ( !@ARGV )
53{
54    print "\{\"error\":\"__moduleid__ called with no arguments\"\}\n";
55    exit;
56}
57
58$req = decode_json( shift );
59
60## messaging setup
61
62sub sendmsg {};
63
64if ( $enable_msg ) {
65   
66    my $rc = eval {
67        require IO::Socket;   IO::Socket->import();
68    };
69
70    my $domsg = $$req{ "_uuid" } && $$req{ "_udpport" } && $$req{ "_udphost" };
71
72    my $sock;
73    $sock = IO::Socket::INET->new( Proto => 'udp', PeerPort => $$req{ "_udpport" }, PeerAddr => $$req{ "_udphost" } ) if $domsg;
74
75    sub sendmsg {
76        return if !$domsg;
77        my $text = $_[0];
78        my $prog = $_[1];
79        print "sendmsg: $prog $text\n" if $debug;
80
81        if ( length( $text ) || length( $prog ) ) {
82            my $msg  = {};
83            $$msg{ "_uuid" } = $$req{ "_uuid" };
84            $$msg{ "_textarea" } = $text if length( $text );
85            $$msg{ "_progress" } = $prog if length( $prog );
86            $sock->send( encode_json( $msg ) );
87        }
88    }
89}
90
91
92## format inputs for replacement
93sub formatinput {
94    my $x    = $_[0];
95    my $dec  = $_[1];
96    my $mlen = $_[2];
97    my $fmt  = "\%.${mlen}f";
98    my $out  = sprintf( $fmt, $x );
99    $out = substr( $out, 0, $mlen );
100    $out .= '0'x( $mlen - length( $out ) );
101    $out;
102}
103
104$res = {};
105
106# assemble output
107
108$$res{ "note" } = "__moduleid__ executable";
109
110if ( length( $save_in_log ) ) {
111    my $rc = eval {
112        require Data::Dumper;;   Data::Dumper->import();
113    };
114
115    open OUT, ">>$save_in_log";
116    print OUT "-"x20 . "\n";
117    print OUT `date`;
118    print OUT "$0\n";
119    print OUT "--- input ---\n";
120    print OUT Dumper($req);
121    print OUT "--- output ---\n";
122    print OUT Dumper($res);
123    print OUT "-"x20 . "\n";
124    close OUT;
125}
126
127print encode_json( $res ) . "\n";
128
Note: See TracBrowser for help on using the repository browser.