File: TraceFileEvent.pm

package info (click to toggle)
ns2 2.35%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 78,756 kB
  • ctags: 27,476
  • sloc: cpp: 172,923; tcl: 107,130; perl: 6,391; sh: 6,143; ansic: 5,846; makefile: 812; awk: 525; csh: 355
file content (256 lines) | stat: -rw-r--r-- 5,406 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256

# Perl package for representing events in NS trace files


# ***XXX*** Need to work out comments.  Probably make it so that comments
#           result in single data item called comment

package NS::TraceFileEvent;

use 5.005;
use strict;
use warnings;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

BEGIN {
	use Text::Balanced qw(extract_bracketed);
	use Exporter ();


	$VERSION = 1.00;

	@ISA = qw(Exporter);
	@EXPORT = qw();
	%EXPORT_TAGS = ();
	@EXPORT_OK = qw(&string_to_hashref &hashref_to_string &quote_if_needed);
}

# the constructor:
sub new {
	my $self  = shift;
	my $class = ref($self) || $self;
	my $obj = { type => undef,
		    timestamp => undef,
		    data => {}
		  };

	bless $obj, $class;  # make the hash into an object


	# if there are still more arguments to process, then use them
	# to initialize the object.  Otherwise, object will be uninitialized.
	if (scalar(@_) == 1) {
		# init with string
		$obj = $obj->set_string_representation(shift);
	} elsif (@_) {
		# init with data
		$obj->set_type(shift);
		$obj->set_timestamp(shift);
		if (ref $_[0] eq 'HASH') {
			$obj->set_data(shift);
		} else {
			$obj->set_data({@_});
		}
	}

	return $obj;
}


# get the type of event
sub get_type {
	my $self = shift;
	return $self->{'type'};
}

# set the type of the event
sub set_type {
	my ($self, $type) = @_;
	$self->{'type'} = $type;

	# invalidate string representation
	delete $self->{'string_representation'};
}

# get the timestamp for the event
sub get_timestamp {
	my $self = shift;
	return $self->{'timestamp'};
}

# set the timestamp of the event
sub set_timestamp {
	my ($self, $time) = @_;
	$self->{'timestamp'} = $time;

	# invalidate string representation
	delete $self->{'string_representation'};
}

# get a value from the event
sub get {
	my ($self, $key) = @_;
	return $self->{'data'}{$key}
}

# set a value in the event
sub set {
	my ($self, $key, $value) = @_;
	$self->{'data'}{$key} = $value;

	# invalidate string representation
	delete $self->{'string_representation'};
}

# remove a value from the event
sub remove {
	my ($self, $key) = @_;
	delete $self->{'data'}{$key};
	
	# invalidate string representation
	delete $self->{'string_representation'};
}

# get all data
sub get_data {
	my $self = shift;
	return $self->{'data'};
}

# set all data
sub set_data {
	my $self = shift;
	my $new_data = shift;
	if (defined $new_data and ref $new_data ne 'HASH') {
		die "NS::TraceFileEvent::set_data wants a hash reference";
	}
	$self->{'data'} = $new_data;

	# invalidate string representation
	delete $self->{'string_representation'};
}

# return the string representation of the event, suitable for writing
# to an ns trace file
sub get_string_representation {
	my $self = shift;

	unless (defined $self->{'string_representation'}) {
		# construct a string representation if none is cached

		unless (defined $self->{'type'} and
			defined $self->{'timestamp'}) {
			return undef; # abort if object is not initialized
		}

		if ($self->{'type'} =~ m/^#/ and
		    defined $self->{'data'}{'#'} and
		    (keys %{$self->{'data'}} == 1)) {
	 		# freeform comment line
			$self->{'string_representation'} =
		    		$self->{'type'} . ' ' . $self->{'data'}{'#'};
		} else {
			# normal event
			$self->{'string_representation'} =
				$self->{'type'} . ' ' .
				$self->{'timestamp'} . ' ' .
				hashref_to_string($self->{'data'});
		}
	}

	return $self->{string_representation};
}

# set all data via string representation
# returns undef if operation fails (string was malformed) and returns
# the object itself if the operation succeeds.
sub set_string_representation {
	my ($self, $string) = @_;

	chomp $string; # remove any trailing newline
	$self->{'string_representation'} = $string; # save a copy

	my ($type, $time, $data) = split ' ', $string, 3;
	$self->{'type'} = $type;

	if ($type =~ m/^#/) {
		# we don't try to parse the comment
		$self->{'timestamp'} = '*';
		$self->{'data'} = {'#' => "$time $data"};
	} else {
		unless (defined $type and defined $time) {
			# event is malformed if type or time is malformed
			$self->{'type'} = undef;
			$self->{'timestamp'} = undef;
			$self->{'data'} = {};
			delete $self->{'string_representation'};
			return undef;
		}

		$self->{'timestamp'} = $time;
		$self->{'data'} = string_to_hashref($data);
	}

	return $self;
}




# exportable functions


sub quote_if_needed {
	my $value = shift;

	# if delimited in brackets or quotes already, then don't change
	if ($value =~ m/^(".*"|{.*})$/) {
		return $value;
	}

	#otherwise, see if it needs quoting
	if ($value =~ m/ / or
	    $value eq '') {
		$value = "{$value}";
	}

	return $value;
}


sub string_to_hashref {
	my $string = shift;
	my ($tag, $value, %hash);

	while (defined $string and
	       ($tag, $string) = split(' ', $string, 2)) {
		$tag =~ s/-(.*)/$1/;
		if ($string =~ m/^({|\[|")/) {
			# if the value appears to be quoted, then
			# find the end of the quote
			($hash{$tag}, $string) = extract_bracketed($string,
								   '{["');
		} else {
			# value doesn't appear to be quoted, so whitespace
			# will mark the end of the value
			($hash{$tag}, $string) = split(' ', $string, 2);
		}
	}

	return \%hash;
}

sub hashref_to_string {
    my $ref = shift;
    my %data = %$ref;
    return join (' ', map { "-$_ ". quote_if_needed($data{$_}) }
	                  keys %data);
}




# a Perl module must return a true value
1;