Commits

Ville Suoranta authored 7b9c70c43c2
Remove pybot html

gcwrap/python/scripts/pybot/casa/bin/casapy-version

Deleted
1 -#!/usr/bin/perl
2 -use local::lib;
3 -use IO::Select;
4 -use Expect;
5 -
6 -$debug = 0;
7 -
8 -########################################
9 -######### variable used to clean up...
10 -########################################
11 -$xvfb_pid = 0;
12 -$authority = '';
13 -########################################
14 -
15 -END {
16 - if ( $xvfb_pid ) {
17 - kill 9, $xvfb_pid;
18 - }
19 - if ( $authority ) {
20 - unlink($authority);
21 - }
22 -}
23 -
24 -##
25 -## takes display number & authority file
26 -sub create_authority {
27 - my $display_num = shift;
28 - my $file = shift;
29 - my $cookie = '';
30 - my $seed = 0;
31 - for (1..10) {
32 - srand(time+$$+$seed);
33 - $cookie .= sprintf("%4.5x", ($seed = int(rand(65536))));
34 - }
35 - $cookie = substr $cookie, 0, 32;
36 - open( XAUTH, "xauth -f $file add :$display_num . $cookie 2>&1 |" );
37 - print "creating xauthority file $file for display :$display_num...\n" if $debug;
38 - while ( <XAUTH> ) {
39 - print " $_" if $debug;
40 - }
41 - close(XAUTH);
42 -}
43 -
44 -sub launch_xvfb {
45 - my $authority = shift;
46 - my $display=4;
47 - my $failed = 1;
48 - while ( $failed ) {
49 - $failed = 0;
50 - pipe my $read, my $write or die "could not create pipe";
51 - ###
52 - ### make pipe unbuffered...
53 - ###
54 - select((select($write), $| = 1)[0]);
55 - if ( my $pid = fork( ) ) {
56 - ########################################
57 - #### parent
58 - ########################################
59 - $xvfb_pid = $pid;
60 - close $write;
61 - print "trying to start xvfb on display :$display...\n" if $debug;
62 - my $readable = IO::Select->new($read);
63 -
64 - while ( my @ready = $readable->can_read(5) ) {
65 - foreach $fh ( @ready ) {
66 - my $buf = <$fh>;
67 - if ( $buf ) {
68 - # output read
69 - print " $buf" if $debug;
70 - if ( $buf =~ m|server.*already active|i ) {
71 - $readable->remove($fh);
72 - close($fh);
73 - $failed = 1;
74 - $display += 1;
75 - }
76 - } else {
77 - # connection closed
78 - $readable->remove($fh);
79 - close($fh);
80 - $failed = 1;
81 - $display += 1;
82 - }
83 - }
84 - }
85 - } else {
86 - ########################################
87 - #### child
88 - ########################################
89 - close $read;
90 - open(STDERR, ">&=" . fileno($write)) or die "cannot dup to stderr";
91 - open(STDOUT, ">&=" . fileno($write)) or die "cannot dup to stdout";
92 - my @args = ( 'Xvfb', ":$display", "-screen", "0", "2048x2048x24+32", "-auth", $authority );
93 - exec { $args[0] } @args;
94 - die "exec failed...";
95 - }
96 - }
97 - return $display;
98 -}
99 -
100 -###
101 -### make stdout & stderr unbuffered...
102 -###
103 -select((select(STDOUT), $| = 1)[0]);
104 -select((select(STDERR), $| = 1)[0]);
105 -
106 -if ( scalar(@ARGV) == 1 ) {
107 - my $e = @ARGV[0];
108 - die "initialization file ($e) does not exist, or is not a file" unless -f $e;
109 - open(F,"< $e") or die "cannot read $e";
110 - my @x = <F>;
111 - close(F);
112 - eval join('',@x);
113 -} elsif ( scalar(@ARGV) > 1 ) {
114 - die "casapy-version takes at most one argument (an initialization file)...";
115 -}
116 -
117 -$authority = "/tmp/.xauth-$$";
118 -open( XAUTH, "> $authority" ) or die "cannot create xauth file...";
119 -close( XAUTH );
120 -
121 -$display = launch_xvfb( $authority );
122 -create_authority( $display, $authority );
123 -
124 -$ENV{'DISPLAY'} = "localhost:$display.0";
125 -$ENV{'XAUTHORITY'} = $authority;
126 -
127 -unless ( $casa_pid = fork( ) ) {
128 -
129 - ### all casa processes started are children of this child
130 - setpgrp(0,0);
131 -
132 - my @args = ( "--nologger", "--log2term", "--colors=NoColor" );
133 - $expect = new Expect( "casapy", @args );
134 - $expect->log_stdout(0);
135 -
136 - my $timeout = 30;
137 - $expect->expect( $timeout, [ qr/CASA\s+<\S*?>/ => sub { ### seems like quick startup/shutdown leaves the viewer dangling
138 - sleep(10); $expect->send("exit\n"); exp_continue; } ],
139 - [ qr/leaving casapy.../ => sub { my $exp = shift; sleep(5); } ],
140 - [ qr/CASA Version\s+(\S+)\s+\(r(\d+)\)/ => sub { my @m = $expect->matchlist( ); print "VERSION> $m[0] $m[1]\n";
141 - my $exp = shift; exp_continue; } ],
142 - [ timeout => sub { $timeout_occurred = 1; } ],
143 - [ eof => sub { $eof_occurred = 1; } ] );
144 -
145 - exit $expect->exitstatus( );
146 -}
147 -
148 -waitpid( $casa_pid, 0 );
149 -exit(0);

Everything looks good. We'll let you know here if there's anything you should know about.

Add shortcut