Changeset 29
- Timestamp:
- 04/23/07 13:41:28 (2 years ago)
- Files:
-
- trunk/op_server.pl (modified) (28 diffs)
Legend:
- Unmodified
- Added
- Removed
- Modified
- Copied
- Moved
trunk/op_server.pl
r28 r29 1 #!/usr/bin/perl -w1 #!/usr/bin/perl 2 2 3 3 # Flash Operator Panel. http://www.asternic.org … … 22 22 23 23 use strict; 24 use warnings; 24 25 use integer; 25 26 … … 644 645 645 646 if ( $tipo eq "buttons" ) { 646 if ( ! grep {$filename eq $_} @btninclude ) {647 if ( !grep { $filename eq $_ } @btninclude ) { 647 648 push( @btninclude, $filename ); 648 649 } … … 653 654 } 654 655 if ( $tipo eq "style" ) { 655 if ( ! grep {$filename eq $_} @styleinclude ) {656 if ( !grep { $filename eq $_ } @styleinclude ) { 656 657 push( @styleinclude, $filename ); 657 658 } … … 1506 1507 my $contextoboton = $key; 1507 1508 if ( $contextoboton =~ m/\@/ ) { 1508 my @parte = split( /\@/, $contextoboton, 2 ); 1509 $contextoboton = $parte[1]; 1509 ($contextoboton) = split( /\@/, $contextoboton, 2 ); 1510 1510 $contextoboton =~ tr/a-z/A-Z/; 1511 1511 } … … 1525 1525 my $contextoboton = $key; 1526 1526 if ( $contextoboton =~ m/\@/ ) { 1527 my @parte = split( /\@/, $contextoboton, 2 ); 1528 $contextoboton = $parte[1]; 1527 ($contextoboton) = split( /\@/, $contextoboton, 2 ); 1529 1528 $contextoboton =~ tr/a-z/A-Z/; 1530 1529 } … … 1544 1543 my $contextoboton = $key; 1545 1544 if ( $contextoboton =~ m/\@/ ) { 1546 my @parte = split( /\@/, $contextoboton, 2 ); 1547 $contextoboton = $parte[1]; 1545 ($contextoboton) = split( /\@/, $contextoboton, 2 ); 1548 1546 $contextoboton =~ tr/a-z/A-Z/; 1549 1547 } … … 1564 1562 my $contextoboton = $key; 1565 1563 if ( $contextoboton =~ m/\@/ ) { 1566 my @parte = split( /\@/, $contextoboton, 2 ); 1567 $contextoboton = $parte[1]; 1564 ($contextoboton) = split( /\@/, $contextoboton, 2 ); 1568 1565 $contextoboton =~ tr/a-z/A-Z/; 1569 1566 } … … 1584 1581 my $contextoboton = $key; 1585 1582 if ( $contextoboton =~ m/\@/ ) { 1586 my @parte = split( /\@/, $contextoboton, 2 ); 1587 $contextoboton = $parte[1]; 1583 ($contextoboton) = split( /\@/, $contextoboton, 2 ); 1588 1584 $contextoboton =~ tr/a-z/A-Z/; 1589 1585 } … … 2181 2177 # Removes the context if its set 2182 2178 2183 my @pedazos = split( /&/, $canal ); 2184 $canal = $pedazos[0]; 2179 ($canal) = split( /&/, $canal ); 2185 2180 2186 2181 # Checks if the channel name has an equal sign … … 2233 2228 my $server = ""; 2234 2229 2235 my @pedazos = split( /&/, $canal ); 2236 $canal = $pedazos[0]; 2230 ($canal) = split( /&/, $canal ); 2237 2231 2238 2232 if ( $canal =~ /\^/ ) { 2239 @pedazos = split( /\^/, $canal ); 2240 $server = $pedazos[0]; 2241 $canal = $pedazos[1]; 2233 ( $server, $canal ) = split( /\^/, $canal ); 2242 2234 } 2243 2235 … … 2276 2268 print_datos(1); 2277 2269 2278 my @pedazos = split( /&/, $canal ); 2279 $canal = $pedazos[0]; 2270 ($canal) = split( /&/, $canal ); 2280 2271 2281 2272 if ( $canal =~ /\^/ ) { 2282 @pedazos = split( /\^/, $canal ); 2283 $server = $pedazos[0]; 2284 $canal = $pedazos[1]; 2273 ( $server, $canal ) = split( /\^/, $canal ); 2285 2274 } 2286 2275 … … 2740 2729 while ( my ( $key, $val ) = each(%hash_temporal) ) { 2741 2730 if ( defined($val) && $val =~ /\^/ ) { 2742 my @partes = split( /\^/, $val, 2 ); 2743 $hash_temporal{$key} = $partes[0]; 2744 my $resto_de_parametros = $partes[1]; 2745 @partes = split( /\^/, $resto_de_parametros ); 2731 2732 #my @partes = split( /\^/, $val, 2 ); 2733 #$hash_temporal{$key} = $partes[0]; 2734 #my $resto_de_parametros = $partes[1]; 2735 ( $hash_temporal{$key}, my $resto ) = split( /\^/, $val, 2 ); 2736 my @partes = split( /\^/, $resto ); 2746 2737 foreach my $value (@partes) { 2747 2738 my @partes2 = split( /: /, $value ); … … 2803 2794 if ( defined( $hash_temporal{"ActionID"} ) ) { 2804 2795 if ( $hash_temporal{"ActionID"} =~ /^timeout/i ) { 2805 ( $canalid, $timeout) = split( /\|/, $hash_temporal{"ActionID"} );2796 ( $canalid, $timeout ) = split( /\|/, $hash_temporal{"ActionID"} ); 2806 2797 $evento = "Timeout"; 2807 2798 $unico_id = "YYYY-$server"; … … 2998 2989 2999 2990 if ( $tempval =~ m/\@/ ) { 3000 my @partes = split( /\@/, $tempval, 2 ); 3001 $dst_exten = $partes[0]; 3002 $dst_context = $partes[1]; 2991 ( $dst_exten, $dst_context ) = split( /\@/, $tempval, 2 ); 3003 2992 } 3004 2993 else { … … 4701 4690 4702 4691 for ( keys %datos ) { 4703 my $ignorame = 0; 4704 my @pedazote = split( /-/, $_ ); 4705 my $current_server = $pedazote[1]; 4692 my $ignorame = 0; 4693 my ($current_server) = split( /-/, $_ ); 4706 4694 if ( "$server" ne "$current_server" ) { 4707 4695 next; … … 6460 6448 6461 6449 # The closed connections belong to an asterisk manager port 6462 my @partes = split( /\|/, $manager_socket{$socket} );6463 6450 my @pp = (); 6464 6451 my $counter = 0; … … 7112 7099 @pedazos = split( /&/, $canal ); 7113 7100 $origin_context = $pedazos[1]; 7114 my @pedazos2 = split( /\^/, $pedazos[0] ); 7115 $origin_server = $pedazos2[0]; 7116 $origin_channel = $pedazos2[1]; 7101 ( $origin_server, $origin_channel ) = split( /\^/, $pedazos[0] ); 7117 7102 } 7118 7103 else { 7119 my @pedazos2 = split( /\^/, $canal ); 7120 $origin_server = $pedazos2[0]; 7121 $origin_channel = $pedazos2[1]; 7104 ( $origin_server, $origin_channel ) = split( /\^/, $canal ); 7122 7105 } 7123 7106 } … … 7280 7263 if ( $destino ne "0" ) { 7281 7264 log_debug( "$heading destino es igual a $destino", 32 ) if DEBUG; 7282 my @pedazos2 = split( /\^/, $destino ); 7283 $destin_server = $pedazos2[0]; 7284 $destino = $pedazos2[1]; 7285 ( $destino, my $nada ) = split( /\&/, $pedazos2[1] ); 7265 ( $destin_server, $destino ) = split( /\^/, $destino ); 7266 ($destino) = split( /\&/, $destino ); 7286 7267 log_debug( "$heading El boton de destino es $destino en el server $destin_server", 64 ) if DEBUG; 7268 print("$heading El boton de destino es $destino en el server $destin_server\n"); 7287 7269 } 7288 7270 } … … 7531 7513 if ( $canal_destino ne "-1" ) { 7532 7514 if ( $canal_destino =~ /\@/ ) { 7533 @pedazos = split( /\@/, $canal_destino ); 7534 $canal_destino = $pedazos[0]; 7535 $contexto = $pedazos[1]; 7515 ( $canal_destino, $contexto ) = split( /\@/, $canal_destino ); 7536 7516 } 7537 7517 … … 7629 7609 7630 7610 if ( $extension_destino =~ /\@/ ) { 7631 @pedazos = split( /\@/, $extension_destino ); 7632 $extension_destino = $pedazos[0]; 7633 $contexto = $pedazos[1]; 7611 ( $extension_destino, $contexto ) = split( /\@/, $extension_destino ); 7634 7612 } 7635 7613 … … 8318 8296 my $estado = substr( $valor, $statPos ); 8319 8297 $valor =~ s/\s+/ /g; 8320 my @parametros = split( " ", $valor ); 8321 my $interno = $parametros[0]; 8298 my ( $interno, $dirip ) = split( " ", $valor ); 8322 8299 8323 8300 if ( $interno =~ /\// ) { 8324 my @partecitas = split( /\//, $interno ); 8325 $interno = $partecitas[0]; 8326 } 8327 my $dirip = $parametros[1]; 8301 ($interno) = split( /\//, $interno ); 8302 } 8328 8303 8329 8304 if ( defined($estado) && $estado ne "" ) { … … 8412 8387 $valor =~ s/\s+/ /g; 8413 8388 if ( $valor eq "" ) { next; } 8414 my @parametros = split( " ", $valor ); 8415 my $interno = $parametros[0]; 8416 my $dirip = $parametros[1]; 8417 $interno =~ s/(.*)\/(.*)/$1/g; 8389 my ( $interno, $dirip ) = split( " ", $valor ); 8390 ( $interno, undef ) = split( /\//, $interno ); 8418 8391 8419 8392 if ( defined($interno) ) { … … 8624 8597 if ( defined($_) && $_ ne "" ) { 8625 8598 log_debug( "$heading Enviando status a " . $ip_addy{$_}, 16 ) if DEBUG; 8626 my @pedazos= split( /\|/, $manager_socket{$_} );8627 8628 if ( $ pedazos[0]eq $ip_addy{$_} ) {8599 my ($ip) = split( /\|/, $manager_socket{$_} ); 8600 8601 if ( $ip eq $ip_addy{$_} ) { 8629 8602 my $contador = 0; 8630 8603 foreach my $valor (@manager_host) { 8631 if ( $valor eq $ pedazos[0]) {8604 if ( $valor eq $ip ) { 8632 8605 $nro_servidor = $contador; 8633 8606 } … … 8654 8627 # Send commands to check the mailbox status for each mailbox defined 8655 8628 while ( my ( $key, $val ) = each(%mailbox) ) { 8656 my @pedacitos = split( /\^/, $key ); 8657 my $servidormbox = $pedacitos[0]; 8629 my ($servidormbox) = split( /\^/, $key ); 8658 8630 if ( "$servidormbox" eq "$nro_servidor" ) { 8659 8631 log_debug( "$heading mailbox $ip_addy{$_} $key $val", 32 ) if DEBUG; … … 8792 8764 return; 8793 8765 } 8794 8795 # my @partes = split( /\|/, $manager_socket{$socket} );8796 8797 # $comando = "";8798 8766 8799 8767 if ( $comando eq "" ) { … … 9033 9001 9034 9002 @chars_number = split( //, $numero ); 9035 @chars_format = split( //, $format ); 9036 9037 @chars_format = reverse @chars_format; 9003 @chars_format = reverse split( //, $format ); 9038 9004 9039 9005 my $parate = 0; … … 9061 9027 } 9062 9028 9063 @result = reverse @result; 9064 $devuelve = join( "", @result ); 9029 $devuelve = join( "", reverse @result ); 9065 9030 $devuelve =~ s/\${CLIDNAME}/$name/gi; 9066 9031 return $devuelve;
