| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package DCOP; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 1 |  |  | 1 |  | 30108 | use 5.008001; | 
|  | 1 |  |  |  |  | 4 |  | 
|  | 1 |  |  |  |  | 48 |  | 
| 4 | 1 |  |  | 1 |  | 6 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 147 |  | 
| 5 | 1 |  |  | 1 |  | 8 | use warnings; | 
|  | 1 |  |  |  |  | 7 |  | 
|  | 1 |  |  |  |  | 1059 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | our $VERSION = '0.038'; | 
| 8 |  |  |  |  |  |  | our $DEBUG   = 0; | 
| 9 |  |  |  |  |  |  |  | 
| 10 |  |  |  |  |  |  | ###################################################### | 
| 11 |  |  |  |  |  |  | # Constructor | 
| 12 |  |  |  |  |  |  | # Params: | 
| 13 |  |  |  |  |  |  | #   user      - user name to be used with DCOP | 
| 14 |  |  |  |  |  |  | #   session   - (optional), if noSession is not specified and user is, the | 
| 15 |  |  |  |  |  |  | #               first DCOP session belonging to this user is assigned | 
| 16 |  |  |  |  |  |  | #   noSession - (optional), if user is specified, then do not request DCOP | 
| 17 |  |  |  |  |  |  | #               to return session for user | 
| 18 |  |  |  |  |  |  | #   target    - what is the DCOP target to handle | 
| 19 |  |  |  |  |  |  | #   control   - what is the DCOP target's control to use | 
| 20 |  |  |  |  |  |  | sub new { | 
| 21 | 1 |  |  | 1 | 1 | 210 | my $proto  = shift; | 
| 22 | 1 |  | 33 |  |  | 9 | my $class  = ref($proto) || $proto; | 
| 23 | 1 |  |  |  |  | 7 | my %params = @_; | 
| 24 | 1 |  |  |  |  | 2 | my $self   = {}; | 
| 25 | 1 |  |  |  |  | 3 | bless( $self, $class ); | 
| 26 | 1 |  |  |  |  | 3265 | chomp( my $basepath = `kde-config --expandvars --exec-prefix` ); | 
| 27 | 1 |  |  |  |  | 117 | $self->{dcop}  = "$basepath/bin/dcop "; | 
| 28 | 1 |  |  |  |  | 1677 | $self->{start} = localtime; | 
| 29 | 1 | 50 |  |  |  | 18 | $self->{user}  = $params{user} if ( $params{user} ); | 
| 30 | 1 | 50 | 33 |  |  | 21 | if ( $self->{user} && !$params{noSession} ) { | 
| 31 | 0 |  |  |  |  | 0 | $self->_findSession( $params{session} ); | 
| 32 |  |  |  |  |  |  | } | 
| 33 | 1 | 50 |  |  |  | 10 | $self->{target}  = $params{target}  if ( $params{target} ); | 
| 34 | 1 | 50 |  |  |  | 12 | $self->{control} = $params{control} if ( $params{control} ); | 
| 35 | 1 | 50 |  |  |  | 9 | $self->{dcop} .= "--user $self->{user} "       if ( $self->{user} ); | 
| 36 | 1 | 50 |  |  |  | 29 | $self->{dcop} .= "--session $self->{session} " if ( $self->{session} ); | 
| 37 | 1 | 50 |  |  |  | 12 | $self->{dcop} .= "$self->{target} "            if ( $self->{target} ); | 
| 38 | 1 | 50 |  |  |  | 38 | $self->{dcop} .= "$self->{control} "           if ( $self->{control} ); | 
| 39 | 1 | 50 |  |  |  | 181 | print "DCOP command is [$self->{dcop}]\n" if ($DEBUG); | 
| 40 | 1 |  |  |  |  | 69 | return $self; | 
| 41 |  |  |  |  |  |  | } | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  | ############################################### | 
| 44 |  |  |  |  |  |  | # Get the first session of user, else, just | 
| 45 |  |  |  |  |  |  | # use the provided session | 
| 46 |  |  |  |  |  |  | sub _findSession { | 
| 47 | 0 |  |  | 0 |  |  | my ( $self, $sessionParam ) = @_; | 
| 48 | 0 | 0 |  |  |  |  | if ($sessionParam) { | 
| 49 | 0 | 0 |  |  |  |  | print "session provided, using it.\n" if ($DEBUG); | 
| 50 | 0 |  |  |  |  |  | $self->{session} = $sessionParam; | 
| 51 | 0 |  |  |  |  |  | return; | 
| 52 |  |  |  |  |  |  | } | 
| 53 |  |  |  |  |  |  |  | 
| 54 | 0 | 0 |  |  |  |  | print "session not provided. finding it.\n" if ($DEBUG); | 
| 55 | 0 | 0 |  |  |  |  | if ( !$self->{user} ) { | 
| 56 | 0 |  |  |  |  |  | croak( | 
| 57 |  |  |  |  |  |  | 'No user specified. DCOP session cannot be found without an user.'); | 
| 58 |  |  |  |  |  |  | } | 
| 59 |  |  |  |  |  |  |  | 
| 60 | 0 |  |  |  |  |  | my $sessions = `$self->{dcop} --user $self->{user} --list-sessions`; | 
| 61 | 0 |  |  |  |  |  | my @sessions = split /\n/, $sessions; | 
| 62 | 0 |  |  |  |  |  | my $session; | 
| 63 |  |  |  |  |  |  |  | 
| 64 | 0 |  |  |  |  |  | for (@sessions) { | 
| 65 | 0 | 0 |  |  |  |  | if (/DCOPserver/) { | 
| 66 | 0 | 0 |  |  |  |  | $session = $_ if (/DCOPserver/); | 
| 67 | 0 |  |  |  |  |  | last; | 
| 68 |  |  |  |  |  |  | } | 
| 69 |  |  |  |  |  |  | } | 
| 70 | 0 | 0 |  |  |  |  | $session = $1 if ( $session =~ /([._A-Za-z0-9]+)/ ); | 
| 71 | 0 | 0 |  |  |  |  | print "user = $self->{user}, session = $session\n" if ($DEBUG); | 
| 72 | 0 |  |  |  |  |  | $self->{session} = $session; | 
| 73 |  |  |  |  |  |  | } | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | sub _getCommand { | 
| 76 | 0 |  |  | 0 |  |  | my $self = shift; | 
| 77 | 0 |  |  |  |  |  | return $self->{dcop}; | 
| 78 |  |  |  |  |  |  | } | 
| 79 |  |  |  |  |  |  |  | 
| 80 |  |  |  |  |  |  | sub run { | 
| 81 | 0 |  |  | 0 | 1 |  | my $self = shift; | 
| 82 | 0 |  |  |  |  |  | my $args = join " ", @_; | 
| 83 | 0 |  |  |  |  |  | chomp( my $ret = `$self->{dcop} $args` ); | 
| 84 | 0 |  |  |  |  |  | return $ret; | 
| 85 |  |  |  |  |  |  | } | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  | 1; | 
| 88 |  |  |  |  |  |  | __END__ |