home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Util.pm < prev    next >
Encoding:
Perl POD Document  |  2003-09-16  |  2.2 KB  |  103 lines
  1. # -*- perl -*-
  2.  
  3. #
  4. # $Id: Util.pm,v 1.2 2003/09/16 18:16:45 joker Exp $
  5. # Author: Slaven Rezic
  6. #
  7. # Copyright (C) 2003 Slaven Rezic. All rights reserved.
  8. # This program is free software; you can redistribute it and/or
  9. # modify it under the same terms as Perl itself.
  10. #
  11. # Mail: slaven@rezic.de
  12. # WWW:  http://www.rezic.de/eserte/
  13. #
  14.  
  15. package Tk::Pod::Util;
  16. use strict;
  17. use vars qw($VERSION @EXPORT_OK);
  18. $VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
  19.  
  20. use base qw(Exporter);
  21. @EXPORT_OK = qw(is_in_path is_interactive detect_window_manager);
  22.  
  23. # REPO BEGIN
  24. # REPO NAME is_in_path /home/e/eserte/src/repository
  25. # REPO MD5 1b42243230d92021e6c361e37c9771d1
  26.  
  27. sub is_in_path {
  28.     my($prog) = @_;
  29.     require Config;
  30.     my $sep = $Config::Config{'path_sep'} || ':';
  31.     foreach (split(/$sep/o, $ENV{PATH})) {
  32.     if ($^O eq 'MSWin32') {
  33.         return "$_\\$prog"
  34.         if (-x "$_\\$prog.bat" ||
  35.             -x "$_\\$prog.com" ||
  36.             -x "$_\\$prog.exe" ||
  37.             -x "$_\\$prog.cmd"
  38.            );
  39.     } else {
  40.         return "$_/$prog" if (-x "$_/$prog" && !-d "$_/$prog");
  41.     }
  42.     }
  43.     undef;
  44. }
  45. # REPO END
  46.  
  47. sub is_interactive {
  48.     if ($^O eq 'MSWin32' || !eval { require POSIX; 1 }) {
  49.     # fallback
  50.     return -t STDIN && -t STDOUT;
  51.     }
  52.  
  53.     # from perlfaq8
  54.     open(TTY, "/dev/tty") or die $!;
  55.     my $tpgrp = POSIX::tcgetpgrp(fileno(*TTY));
  56.     my $pgrp = getpgrp();
  57.     if ($tpgrp == $pgrp) {
  58.     1;
  59.     } else {
  60.     0;
  61.     }
  62. }
  63.  
  64. sub detect_window_manager {
  65.     my $top = shift;
  66.     if ($Tk::platform eq 'MSWin32') {
  67.     return "win32";
  68.     }
  69.     if (   get_property($top, "GNOME_NAME_SERVER")) {
  70.     return "gnome";
  71.     }
  72.     if (   get_property($top, "KWM_RUNNING") # KDE 1
  73.     || get_property($top, "KWIN_RUNNING") # KDE 2
  74.        ) {
  75.     return "kde";
  76.     }
  77.     "x11";
  78. }
  79.  
  80. sub get_property {
  81.     my($top, $prop) = @_;
  82.     my @ret;
  83.     if ($top->property('exists', $prop, 'root')) {
  84.     @ret = $top->property('get', $prop, 'root');
  85.     shift @ret; # get rid of property name
  86.     }
  87.     @ret;
  88. }
  89.  
  90. 1;
  91.  
  92. __END__
  93.  
  94. =head1 NAME
  95.  
  96. Tk::Pod::Util - utility functions
  97.  
  98. =head1 DESCRIPTION
  99.  
  100. This module contains a collection of utility functions for Tk::Pod.
  101.  
  102. =cut
  103.