1## XrtUtils.pm is a sub-module of Graph.pm. It has all the subroutines 2## needed for the Xrt3d part of the package. 3## 4## $Id: XrtUtils.pm,v 1.13 2006/06/07 21:09:33 emile Exp $ $Name: $ 5## 6## This software product is developed by Michael Young and David Moore, 7## and copyrighted(C) 1998 by the University of California, San Diego 8## (UCSD), with all rights reserved. UCSD administers the CAIDA grant, 9## NCR-9711092, under which part of this code was developed. 10## 11## There is no charge for this software. You can redistribute it and/or 12## modify it under the terms of the GNU General Public License, v. 2 dated 13## June 1991 which is incorporated by reference herein. This software is 14## distributed WITHOUT ANY WARRANTY, IMPLIED OR EXPRESS, OF MERCHANTABILITY 15## OR FITNESS FOR A PARTICULAR PURPOSE or that the use of it will not 16## infringe on any third party's intellectual property rights. 17## 18## You should have received a copy of the GNU GPL along with this program. 19## 20## 21## IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY 22## PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL 23## DAMAGES, INCLUDING LOST PROFITS, ARISING OUT OF THE USE OF THIS 24## SOFTWARE, EVEN IF THE UNIVERSITY OF CALIFORNIA HAS BEEN ADVISED OF 25## THE POSSIBILITY OF SUCH DAMAGE. 26## 27## THE SOFTWARE PROVIDED HEREIN IS ON AN "AS IS" BASIS, AND THE 28## UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO PROVIDE MAINTENANCE, 29## SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. THE UNIVERSITY 30## OF CALIFORNIA MAKES NO REPRESENTATIONS AND EXTENDS NO WARRANTIES 31## OF ANY KIND, EITHER IMPLIED OR EXPRESS, INCLUDING, BUT NOT LIMITED 32## TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY OR FITNESS FOR A 33## PARTICULAR PURPOSE, OR THAT THE USE OF THE SOFTWARE WILL NOT INFRINGE 34## ANY PATENT, TRADEMARK OR OTHER RIGHTS. 35## 36## 37## Contact: graph-dev@caida.org 38## 39## 40package Chart::Graph::XrtUtils; 41use Exporter (); 42 43@ISA = qw(Exporter); 44@EXPORT = qw(); 45%EXPORT_TAGS = (UTILS => [qw(&_set_xrtpaths &_set_ldpath &_print_matrix 46 &_print_array &_verify_ticks &_exec_xrt3d &_exec_xrt2d 47 &_exec_netpbm &_exec_xvfb &_try_port &_convert_raster 48 &_childpid_dead &_transfer_file)], 49 ); 50 51Exporter::export_ok_tags('UTILS'); 52 53use Carp; 54use POSIX ":sys_wait_h"; # for waitpid() 55use Chart::Graph::Utils qw(:UTILS); 56 57$cvs_Id = '$Id: XrtUtils.pm,v 1.13 2006/06/07 21:09:33 emile Exp $'; 58$cvs_Author = '$Author: emile $'; 59$cvs_Name = '$Name: $'; 60$cvs_Revision = '$Revision: 1.13 $'; 61 62$VERSION = 3.2; 63 64use strict; 65use File::Basename; 66 67use vars qw($xrt2d $xrt3d); 68 69# 70# Subroutine: set_converterpaths() 71# 72# Description: set paths for converter programs in particular. This 73# subroutine can take one or two arguments and tests if 74# the required converter programs are indeed available 75# for the choosen method to convert a file from one 76# graphics format to another. 77# 78sub _set_converterpaths { 79 my @converters = @_; 80 81 # Loop through the list of converter seeing which are available 82 foreach my $converter (@converters) { 83 if (not -x $$converter) { 84 if (not $$converter = _get_path($$converter)) { 85 return(0); 86 } 87 } 88 } 89 return(1); 90 } 91 92# 93# Subroutine: _convert_raster($plot_file, $output_file) 94# 95# Description: A subroutine to over see the conversion process from 96# one raster graphic format to another. It will try 97# ImageMagick convert first and if that fails try Netpbm 98# utilities if they are available in that format. 99# 100sub _convert_raster { 101 my $FORMAT = shift; 102 my $plot_file = shift; 103 my $output_file = shift; 104 105 # First try ImageMagick as it is more robust and simpler 106 if (_set_converterpaths(\$convert)) { 107 if (_exec_convert($convert, $FORMAT, $plot_file, $output_file)) { 108 return(1); 109 } else { 110 carp "Attempt to use ImageMagick failed, will try Netpbm." 111 } 112 } else { 113 carp "No ImageMagick found, will try Netpbm." 114 } 115 116 if ($FORMAT eq 'GIF') { 117 _try_netpbm_combo($xwdtopnm, $ppmtogif, $plot_file, $output_file); 118 } 119 elsif ($FORMAT eq 'JPG') { 120 _try_netpbm_combo($xwdtopnm, $ppmtojpg, $plot_file, $output_file); 121 } 122 elsif ($FORMAT eq 'PNG') { 123 _try_netpbm_combo($xwdtopnm, $pnmtopng, $plot_file, $output_file); 124 } else { 125 carp "Untrapped raster image format - XrtUtils.pm internal error"; 126 return(0); 127 } 128} 129 130# 131# Subroutine _try_netpbm_combo($xwdtopbm, pbmtotarget, $xwd_file, $target_file) 132# 133# 134# Description: Contains the logic for testing if a combination of 135# netpbm programs can be accessed and executed to perform 136# the desired conversion. If not, it produces the 137# appropriate error messages. Basically, it saves a 138# batch of conditional statements that would otherwise be 139# repeated. 140# 141sub _try_netpbm_combo { 142 my ($xwdtopbm, $pbmtotarget, $xwd_file, $target_file) = @_; 143 144 if (_set_converterpaths(\$xwdtopbm, \$pbmtotarget)) { 145 if (_exec_netpbm($xwdtopbm, $pbmtotarget, $xwd_file, $target_file)) { 146 return(1); 147 } else { 148 carp "Failure to execute any suitable image " . 149 "converters for create file: $target_file"; 150 return(0); 151 } 152 } else { 153 carp "Unable to find any suitable image converters to " . 154 "create file: $target_file"; 155 return(0); 156 } 157} 158 159# 160# Subroutine: set_xrtpaths() 161# 162# Description: set paths for external programs required by xrt() 163# if they are not defined already 164# 165sub _set_xrtpaths { 166 167 my $xrtver = shift; 168 169 170 171 if (defined($xrtver)) { 172 if ($xrtver eq "xrt2d") { 173 if (not $Chart::Graph::xrt2d = _get_path("xrt2d")) { 174 return 0; 175 } 176 } 177 178 if ($xrtver eq "xrt3d") { 179 if (not $Chart::Graph::xrt3d = _get_path("xrt3d")) { 180 return 0; 181 } 182 } 183 } 184 185 if (not defined($xwdtopnm)) { 186 if (!($xwdtopnm = _get_path("xwdtopnm"))) { 187 return 0; 188 } 189 } 190 191 if (not defined($xvfb)) { 192 if (not $xvfb = _get_path("Xvfb")) { 193 return 0; 194 } 195 } 196 197 # make sure /usr/dt/lib is in the library path 198 _set_ldpath("/usr/dt/lib"); 199 200 return 1; 201} 202 203# 204# Subroutine: set_ldpath() 205# 206# Description: Xvfb has trouble finding libMrm, so we have to add 207# /usr/dt/lib to LD_LIBRARY_PATH 208# 209 210sub _set_ldpath { 211 my ($libpath) = @_; 212 213 if (not defined($ENV{LD_LIBRARY_PATH})) { 214 $ENV{LD_LIBRARY_PATH} = "$libpath"; 215 return 1; 216 } 217 218 my @ldpath = split (/:/, $ENV{LD_LIBRARY_PATH}); 219 220 # make sure library path isn't already defined 221 foreach my $i(@ldpath){ 222 if ($i eq $libpath) { 223 return 1; 224 } 225 } 226 227 # add library path to LD_LIBRARY_PATH 228 $ENV{LD_LIBRARY_PATH} = "$libpath:$ENV{LD_LIBRARY_PATH}"; 229 return 1; 230} 231 232# 233# Subroutine: print_matrix() 234# 235# Description: print out all the elements 236# in a X by Y matrix, row by row 237# 238 239sub _print_matrix { 240 my ($handle, @matrix) = @_; 241 242 foreach my $row (@matrix){ 243 foreach my $i (@{$row}){ 244 print $handle "$i\t"; 245 } 246 print $handle "\n"; 247 } 248 return 1; 249} 250 251 252# 253# Subroutine: _transfer_file($handle, $data_filename) 254# 255# Description: open file $data_filename. Read the contents 256# and write it into the command file tab delimited. Don't 257# assume data was tab delimited to be safe. 258# 259sub _transfer_file { 260 my $handle = shift; 261 my $data_filename = shift; 262 my $data; 263 my @elements; 264 265 unless(open(DATAHDL, $data_filename)) { 266 carp "Unable to open data file: $data_filename for reading"; 267 return(0); 268 } 269 while (defined($data = <DATAHDL>)) { 270 chomp($data); 271 @elements = split(/\s+/, $data); 272 foreach my $element (@elements) { 273 print $handle $element, "\t"; 274 } 275 print $handle "\n"; 276 } 277 unless(close(DATAHDL)) { 278 carp "Unable to close data file: $data_filename after reading"; 279 } 280 return(1); 281} 282 283# 284# Subroutine: print_array() 285# 286# Description: print out each element of array, one per line 287# 288 289sub _print_array { 290 my ($handle, @array) = @_; 291 my $i; 292 293 foreach $i (@array) { 294 print $handle "$i\n"; 295 } 296 return 1; 297} 298 299# 300# Subroutine: verify_ticks(); 301# 302# Description: check that the number of tick labels is the same 303# as the number of xy rows and columns. we can only have 304# as many ticks as the number of rows or columns 305# we make this subroutine so that the calling subroutine 306# is kept cleaner. 307 308sub _verify_ticks { 309 my ($cnt, $ticks_ref) = @_; 310 311 # if no ticks are given then just 312 # give the xrt binary "1, 2,..." 313 if (not defined($ticks_ref)) { 314 my @def_ticks; 315 for (my $i = 0; $i < $cnt; $i++) { 316 $def_ticks[$i] = $i + 1; 317 } 318 $ticks_ref = \@def_ticks; 319 } 320 321 my $tick_cnt = @{$ticks_ref}; 322 323 if ($cnt ne $tick_cnt){ 324 carp "number of tick labels must equal the number of xy rows and columns"; 325 return 0; 326 } 327 return 1; 328} 329 330# 331# Subroutine: exec_xrt3d() 332# 333# Description: execute the xrt3d program on the command file. 334# xrt3d generates a xwd file. 335# 336sub _exec_xrt3d { 337 my ($command_file) = @_; 338 my ($output); 339 my ($childpid, $port); 340 my $display_env = $ENV{DISPLAY}; 341 my $status; 342 343 if ($Chart::Graph::use_xvfb) { 344 # start the virtual X server 345 ($childpid, $port) = _exec_xvfb(); 346 $status = system("$Chart::Graph::xrt3d -display :$port.0 < $command_file"); 347 } else { 348 # use the local X server 349 # warning: colors might be messed up 350 # depending on your current setup 351 $status = system("$Chart::Graph::xrt3d -display $display_env < $command_file"); 352 } 353 354 #my $status = system("$xrt -display :$port.0 < $command_file"); 355 if (not _chk_status($status)) { 356 return 0; 357 } 358 359 if ($Chart::Graph::use_xvfb) { 360 kill('KILL', $childpid); 361 } 362 363 return 1; 364} 365 366# 367# Subroutine: exec_xrt2d() 368# 369# Description: execute the xrt2d program on the command file. 370# xrt2d generates a xwd file. 371# 372sub _exec_xrt2d { 373 my ($command_file, $options) = @_; 374 my ($output); 375 my ($childpid, $port); 376 my $display_env = $ENV{DISPLAY}; 377 my $status; 378 379 if ($Chart::Graph::use_xvfb) { 380 # start the virtual X server 381 ($childpid, $port) = _exec_xvfb(); 382 printf STDERR "\tXRT is $Chart::Graph::xrt2d\n"; 383 my $status = system("$Chart::Graph::xrt2d -display ipn:$port.0 < $command_file $options"); 384 } else { 385 # use the local X server 386 # warning: colors might be messed up 387 # depending on your current setup 388 $status = system("$Chart::Graph::xrt2d -display $display_env < $command_file $options"); 389 } 390 391 if (not _chk_status($status)) { 392 return 0; 393 } 394 395 if ($Chart::Graph::use_xvfb) { 396 kill('KILL', $childpid); 397 } 398 399 return 1; 400} 401 402# 403# Subroutine: exec_convert 404# 405# 406# Description: Use the Imagemagick 'convert' utility to convert the xwd 407# file into any one of the other common raster image 408# formats used commonly in web page production. 409# 410sub _exec_convert { 411 my ($convert, $FORMAT, $xwd_file, $target_file) = @_; 412 my ($status); 413 414 415 if ($Chart::Graph::debug) { 416 $status = system(join('', "$convert -verbose $xwd_file ", 417 $FORMAT, ":$target_file")); 418 } else { 419 $status = system(join('', "( $convert $xwd_file ", $FORMAT, 420 ":$target_file; ) 2> /dev/null")); 421 } 422 423 if (not _chk_status($status)) { 424 return 0; 425 } 426 return 1; 427} 428# 429# Subroutine: _exec_netpbm 430# 431# 432# Description: Convert a raster image using the older utilities now 433# collected under the name 'netpbm.' Note that not all 434# conversions are commonly included wiht all UNIX 435# distributions so that while older conversions such as 436# 'xwd' -> 'gif' are likely to work, others such as 437# conversions to 'png' may not without downloading new 438# software. 439# 440# The conversion strategy always involves a pipe from the 441# X-windows 'xwd' format to some sort 'pbm' format and 442# then from that universal format into the target format. 443# For this reason, it is more prone to machine 444# architecture issues and other errors. 445# 446sub _exec_netpbm { 447 my ($xwdtopbm, $pbmtotarget, $xwd_file, $target_file) = @_; 448 my ($status); 449 450 if ($Chart::Graph::debug) { 451 $status = system("$xwdtopbm $xwd_file | $pbmtotarget > $target_file"); 452 } else { 453 $status = system(join('', "( $xwdtopbm -quiet $xwd_file | ", 454 "$pbmtotarget -quiet > $target_file; ) ", 455 "2> /dev/null")); 456 } 457 458 if (not _chk_status($status)) { 459 return 0; 460 } 461 return 1; 462} 463 464# 465# Subroutine: exec_xvfb() 466# 467# Description: this starts the vitualX server(X is required by xrt, so 468# we fake out xrt with Xvfb, for speed and compatability) 469# 470# 471sub _exec_xvfb { 472 my $port = 99; 473 my $childpid; 474 my $sleep_time = 1; 475 my $try_count = 0; 476 my $trialnumber; 477 my $childpid_status; 478 479 # starting with port 100, we try to start 480 # the virtual server until we find an open port 481 # because of the nature of the virtual x server 482 # we use, in order to know if we have found an 483 # open port, we have to sleep. 484 # we check the pid of the virtual x process we started 485 # and see if it died or not. 486 487 while ($childpid_status = _childpid_dead($childpid)) { 488 $port++; 489 $try_count++; 490 if ($try_count > 10) { 491 die "Error: Failed too many times\n"; 492 } 493 $trialnumber = _number_to_eng($try_count); 494 print STDERR "*** $trialnumber try ***" unless (not $Chart::Graph::debug); 495 $childpid = _try_port($port); 496 sleep($sleep_time); 497 } 498 print STDERR " SUCCESS!!!\n" unless (not $Chart::Graph::debug); 499 500 # save the childpid so we can stop the virtual server later 501 # save the $port so we can tell xrt where the virtual server is. 502 return ($childpid, $port); 503} 504# 505# Subroutine: try_port(); 506# 507# Description: will try to start Xvfb on specified port 508sub _try_port { 509 510 my ($port) = @_; 511 my ($childpid); 512 513 #fork a process 514 if (not defined($childpid = fork())){ 515 # the fork failed 516 carp "cannot fork: $!"; 517 return 0; 518 } elsif ($childpid == 0) { 519 # we are in the child process 520 if ($Chart::Graph::debug) { 521 if (not exec "$xvfb :$port") { 522 die "can't do $xvfb :$port: $!\n"; 523 } 524 } 525 else { 526 if (not exec "$xvfb :$port 2> /dev/null") { 527 die "can't do $xvfb :$port 2> /dev/null: $!\n"; 528 } 529 } 530 531 die "should never reach here\n"; 532 533 } else { 534 # we are in the parent, return the childpid 535 # so we can kill it later. 536 return $childpid; 537 } 538 539} 540 541# 542# Subroutine: childpid_dead 543# 544# Description: check to see if a PID has died or not 545# 546# 547sub _childpid_dead { 548 my ($childpid) = @_; 549 550 if (not defined($childpid)) { 551 return 1; 552 } 553 554 # WNOHANG: waitpid() will not suspend execution of 555 # the calling process if status is not 556 # immediately available for one of the 557 # child processes specified by pid. 558 return waitpid($childpid, &WNOHANG); 559} 560 5611; 562