trunk/bin/cpe-queue.pl

#!/usr/bin/perl -w

# cpe-queue.pl
#
# 11/12/2007 10:03:53 PM CET  <>

use strict;

use lib './lib';
use CWMP::Queue;
use Getopt::Long;
use File::Slurp;

my $debug = 1;
my $protocol_dump = 0;
my $list = 0;

GetOptions(
        'debug+' => \$debug,
        'protocol-dump!' => \$protocol_dump,
        'list!' => \$list,
);

my $id = shift @ARGV || die "usage: $0 CPE_id [--protocol-dump]\n";

$id =~ s!^.*queue/+!!;
$id =~ s!/+$!!; #!

die "ID isn't valid: $id\n" unless $id =~ m/^\w+$/;

my $q = CWMP::Queue->new({ id => $id, debug => $debug });


if ( $protocol_dump ) {

        warn "generating dump of xml protocol with CPE\n";

        $q->enqueue( 'GetRPCMethods' );
        $q->enqueue( 'GetParameterNames' );

        $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceInfo.SerialNumber', 0 ] );
        $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceInfo.', 1 ] );

        $q->enqueue( 'GetParameterValues', [
                'InternetGatewayDevice.DeviceInfo.SerialNumber',
                'InternetGatewayDevice.DeviceInfo.VendorConfigFile.',
                'InternetGatewayDevice.DeviceInfo.X_000E50_Country',
        ] );
        $q->enqueue( 'SetParameterValues', {
                'InternetGatewayDevice.DeviceInfo.ProvisioningCode' => 'test provision',
#               'InternetGatewayDevice.DeviceInfo.X_000E50_Country' => 1,
        });

#       $q->enqueue( 'Reboot' );

}

if ( $list ) {

        warn "list all jobs for $id\n";

        my @active = ();
        my @queued = ();
        my $hostname = $q->dq->gethostname();

        sub wanted {
          my ($visitcontext, $job) = @_;

          my $data = $job->get_data_path();
          my $nbytes = $job->get_data_size_bytes();
          my $timet = $job->get_time_submitted_secs();
          my $hname = $job->get_hostname_submitted();
          my $jobid = $job->{jobid};

          my $text = sprintf (
                                "%s (%d bytes)\n  Submitted: %s on %s\n",
                                $jobid, $nbytes, scalar localtime $timet, $hname);

                $text .= read_file( $data ) || die "can't open $data: $!";

          if ($job->{active_pid})
          {
                if ($hostname eq $job->{active_host}
                        && !kill (0, $job->{active_pid}))
                {
                  $text = sprintf (
                                "(dead lockfile)\n  %s",
                                $text);
                }
                else {
                  $text = sprintf (
                                "(pid: %d\@%s)\n  %s",
                                $job->{active_pid}, $job->{active_host}, $text);
                }

                push (@active, $text);
          }
          else {
                push (@queued, $text);
          }

          $job->finish();
        }

        $q->dq->visit_all_jobs(\&wanted, undef);
        printf "Jobs: active: %d  queued: %d\n",
                        scalar @active, scalar @queued;
        
        print "Active jobs [", scalar @active, "]\n",join("\n\n", @active) if @active;
        print "Queued jobs [", scalar @queued, "]\n",join("\n\n", @queued) if @queued;

} else {

        warn "injecting some tests commands\n";

        $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.LANDevice.', 1 ] );

        $q->enqueue( 'GetParameterValues', [
                'InternetGatewayDevice.',
        ]);

}
1	#!/usr/bin/perl -w
2
3	# cpe-queue.pl
4	#
5	# 11/12/2007 10:03:53 PM CET <>
6
7	use strict;
8
9	use lib './lib';
10	use CWMP::Queue;
11	use Getopt::Long;
12	use File::Slurp;
13
14	my $debug = 1;
15	my $protocol_dump = 0;
16	my $list = 0;
17
18	GetOptions(
19	'debug+' => \$debug,
20	'protocol-dump!' => \$protocol_dump,
21	'list!' => \$list,
22	);
23
24	my $id = shift @ARGV \|\| die "usage: $0 CPE_id [--protocol-dump]\n";
25
26	$id =~ s!^.*queue/+!!;
27	$id =~ s!/+$!!; #!
28
29	die "ID isn't valid: $id\n" unless $id =~ m/^\w+$/;
30
31	my $q = CWMP::Queue->new({ id => $id, debug => $debug });
32
33
34	if ( $protocol_dump ) {
35
36	warn "generating dump of xml protocol with CPE\n";
37
38	$q->enqueue( 'GetRPCMethods' );
39	$q->enqueue( 'GetParameterNames' );
40
41	$q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceInfo.SerialNumber', 0 ] );
42	$q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceInfo.', 1 ] );
43
44	$q->enqueue( 'GetParameterValues', [
45	'InternetGatewayDevice.DeviceInfo.SerialNumber',
46	'InternetGatewayDevice.DeviceInfo.VendorConfigFile.',
47	'InternetGatewayDevice.DeviceInfo.X_000E50_Country',
48	] );
49	$q->enqueue( 'SetParameterValues', {
50	'InternetGatewayDevice.DeviceInfo.ProvisioningCode' => 'test provision',
51	# 'InternetGatewayDevice.DeviceInfo.X_000E50_Country' => 1,
52	});
53
54	# $q->enqueue( 'Reboot' );
55
56	}
57
58	if ( $list ) {
59
60	warn "list all jobs for $id\n";
61
62	my @active = ();
63	my @queued = ();
64	my $hostname = $q->dq->gethostname();
65
66	sub wanted {
67	my ($visitcontext, $job) = @_;
68
69	my $data = $job->get_data_path();
70	my $nbytes = $job->get_data_size_bytes();
71	my $timet = $job->get_time_submitted_secs();
72	my $hname = $job->get_hostname_submitted();
73	my $jobid = $job->{jobid};
74
75	my $text = sprintf (
76	"%s (%d bytes)\n Submitted: %s on %s\n",
77	$jobid, $nbytes, scalar localtime $timet, $hname);
78
79	$text .= read_file( $data ) \|\| die "can't open $data: $!";
80
81	if ($job->{active_pid})
82	{
83	if ($hostname eq $job->{active_host}
84	&& !kill (0, $job->{active_pid}))
85	{
86	$text = sprintf (
87	"(dead lockfile)\n %s",
88	$text);
89	}
90	else {
91	$text = sprintf (
92	"(pid: %d\@%s)\n %s",
93	$job->{active_pid}, $job->{active_host}, $text);
94	}
95
96	push (@active, $text);
97	}
98	else {
99	push (@queued, $text);
100	}
101
102	$job->finish();
103	}
104
105	$q->dq->visit_all_jobs(\&wanted, undef);
106	printf "Jobs: active: %d queued: %d\n",
107	scalar @active, scalar @queued;
108
109	print "Active jobs [", scalar @active, "]\n",join("\n\n", @active) if @active;
110	print "Queued jobs [", scalar @queued, "]\n",join("\n\n", @queued) if @queued;
111
112	} else {
113
114	warn "injecting some tests commands\n";
115
116	$q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.LANDevice.', 1 ] );
117
118	$q->enqueue( 'GetParameterValues', [
119	'InternetGatewayDevice.',
120	]);
121
122	}