1 # sdp.tcl --
2 #
3 # This module implements a complete SDP parser along with syntax
4 # checking.
5 #
6 # Copyright (c) 1997-2002 The Regents of the University of California.
7 # All rights reserved.
8 #
9 # Redistribution and use in source and binary forms, with or without
10 # modification, are permitted provided that the following conditions are met:
11 #
12 # A. Redistributions of source code must retain the above copyright notice,
13 # this list of conditions and the following disclaimer.
14 # B. Redistributions in binary form must reproduce the above copyright notice,
15 # this list of conditions and the following disclaimer in the documentation
16 # and/or other materials provided with the distribution.
17 # C. Neither the names of the copyright holders nor the names of its
18 # contributors may be used to endorse or promote products derived from this
19 # software without specific prior written permission.
20 #
21 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
22 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
23 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
24 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
25 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
27 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
29 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 #
32 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/common/sdp.tcl,v 1.25 2003/02/21 21:09:42 aswan Exp $
33
34
35 #
36 # This module implements a complete SDP parser along with syntax checking.
37 # The API still probably needs another pass, but here is the current state.
38 # <pre>
39 # set p [new SDPParser]
40 # </pre>
41 # To parse an announcement simply do:
42 # <pre>
43 # % $p parse $announcement
44 # </pre>
45 # This returns a list of SDPMessage objects which each contain a message
46 # within the announcement (could have been a compound announcement). If there
47 # was an error in the parser, the instproc returns an empty list.
48 # <p>
49 # Each SDPMessage contains a list of SDPMedia and SDPTime objects which
50 # contain the media and time desriptions for the message respectively. The
51 # text of the message can be accessed via the 'msgtext_' instance variable.
52 # <p>
53 # The SDPMessage API is as follows:
54 # <ul>
55 # <li>
56 # $m have_field $field : returns 0 or 1 depending on whether field $field was
57 # present in the announcement, e.g., 'c', 'v', 'k', etc.
58 # <li>
59 # $m field_value $field : returns the value of the field $field, empty if it
60 # doesn't exist.
61 # <li>
62 # $m have_attr $a : return 0 of 1 depending on whether attr $a exists in the
63 # message.
64 # <li>
65 # $m attr_value $a : returns the value of attr a. If attribute $a
66 # does not exist it returns an empty list.
67 # <li>
68 # $m attributes : returns a list of all attributes defined in the message.
69 # <li>
70 # $m media $type : returns a list of all media object for media type $type.
71 # <li>
72 # $m obj2str: builds a string SDP announcement from the object information.
73 # </ul>
74 # <p>
75 # The SDPMedia API contains all the above instprocs except for the
76 # 'media' instproc. In accordance with the SDP specification, the
77 # attributes and relevant fields in the SDPMedia object are
78 # initialized to the global ones. Thus when you query the SDPMedia
79 # object for its attributes you get in return all attributes which
80 # pertain to it which includes the global ones and the local
81 # media-specific ones. The same goes for the relevant fields (i c b k a).
82 # <p>
83 # Each SDPMessage, SDPMedia and SDPTime object contains instance
84 # variables for the various values in the SDP fields which can then be queried.
85 # The following is the breakdown as would appear in the announcement.
86 # <p>
87 # Each SDPMessage contains the following instance variables (if defined):
88 # <pre>
89 # v=version_
90 # o=creator_ createtime_ modtime_ nettype_ addrtype_ createaddr_
91 # s=session_name_
92 # i=session_info_
93 # p=phonelist_
94 # e=emaillist_
95 # u=uri_
96 # c=nettype_ addrtype_ caddr_
97 # b=bwmod_:bwval_
98 # z=zoneinfo_
99 # k=crypt_method_:crypt_key_
100 # </pre>
101 # The 'zoneinfo_' variable contains a list of (adjustment time,offset) pairs.
102 # <p>
103 # The 'alltimedes_' instvar contains the list of SDPTime objects for the
104 # message, each of which contain the following instvars (if defined):
105 # <pre>
106 # t=starttime_ endtime_
107 # r=repeat_interval_ active_duration_ offlist_
108 # </pre>
109 # The 'allmedia_' instvar contains a list of SDPMedia objects which contain
110 # the following media-specific instvars (if defined):
111 # <pre>
112 # m=mediatype_ port_ proto_ fmt_
113 # i=session_info_
114 # c=nettype_ addrtype_ caddr_
115 # b=bwmod_:bwval_
116 # k=crypt_method_:crypt_key_
117 # </pre>
118 # Finally, the SDPParser will check for correct syntax and will return an
119 # empty list if an error was discovered.
120 #
121
122 #-------------------------------------------------------------------
123 # Class:
124 # SDPParser
125 # Description:
126 # This module implements a complete SDP parser along with syntax
127 # checking.
128 # See Also:
129 # SDPMedia SDPTime SDPMessage
130 #-------------------------------------------------------------------
131 Class SDPParser
132
133 #-------------------------------------------------------------------
134 # Class:
135 # SDPMedia
136 # Description:
137 # This class defines a single media descrption within an
138 # SDPMessage. For more details, see the SDPParser description.
139 # See Also:
140 # SDPParser
141 #-------------------------------------------------------------------
142 Class SDPMedia
143
144 #-------------------------------------------------------------------
145 # Class:
146 # SDPTime
147 # Description:
148 # This class defines a single media descrption within an
149 # SDPMessage. For more details, see the SDPParser description.
150 # See Also:
151 # SDPParser
152 #-------------------------------------------------------------------
153 Class SDPTime
154
155
156 SDPParser instproc init { {ordered_syntax 1} } {
157 $self next
158 $self instvar nextsym_ ordered_syntax_ parse_error_
159 set nextsym_(start) "v"
160 set nextsym_(v) "o"
161 set nextsym_(o) "s"
162 set nextsym_(s) "i u e p c b t"
163 set nextsym_(i) "u e p c b t"
164 set nextsym_(u) "e p c b t"
165 set nextsym_(e) "e p c b t"
166 set nextsym_(p) "e p c b t"
167 set nextsym_(c) "b t "
168 set nextsym_(b) "t"
169 set nextsym_(t) "t r z k a m"
170 set nextsym_(r) "t z k a m"
171 set nextsym_(z) "k a m"
172 set nextsym_(k) "a m"
173 set nextsym_(a) "a m"
174 set nextsym_(m) "m i:m c:m b:m k:m a:m v"
175 set nextsym_(i:m) "m c:m b:m k:m a:m v"
176 set nextsym_(c:m) "m b:m k:m a:m v"
177 set nextsym_(b:m) "m k:m a:m v"
178 set nextsym_(k:m) "m a:m v"
179 set nextsym_(a:m) "m a:m v"
180
181 set ordered_syntax_ $ordered_syntax
182 set parse_error_ ""
183 }
184
185
186 #-------------------------------------------------------------------
187 # Method:
188 # SDPParser parse_error
189 # Description:
190 # Given the previous key and the current key, return "" if this
191 # is invalid syntax or the current key if the syntax is valid.
192 #-------------------------------------------------------------------
193 SDPParser private check_syntax { last cur media } {
194 $self instvar nextsym_
195
196 if ![info exists nextsym_($last)] {
197 return ""
198 }
199 foreach s $nextsym_($last) {
200 set t [split $s :]
201 if { [lindex $t 0] == $cur } {
202 return $s
203 }
204 }
205 return ""
206 }
207
208 #-------------------------------------------------------------------
209 # Method:
210 # SDPParser parse
211 # Description:
212 # This returns a list of SDPMessage objects which each contain a
213 # message within the announcement (could have been a compound
214 # announcement). If there was an error in the parser, the instproc
215 # returns an empty list.
216 # Arguments:
217 # announcement -- the SDP announcement to parse
218 #-------------------------------------------------------------------
219 SDPParser instproc parse { announcement } {
220 $self instvar parse_error_ ordered_syntax_
221
222 set media ""
223 set allmsgs ""
224 set lasttag "start"
225 set lines [split $announcement "\n"]
226 set parse_error_ ""
227
228 set lnum 0
229 foreach line $lines {
230 incr lnum
231 set line [string trimright $line]
232 if { $line=={} } continue
233 set sline [split $line =]
234 set tag [lindex $sline 0]
235 set value [join [lrange $sline 1 end]]
236
237 set ret [$self check_syntax $lasttag $tag $media]
238 if { $ret == "" && $ordered_syntax_==1 } {
239 set parse_error_ "$class: syntax error between\
240 $lasttag and $tag in line $lnum."
241 foreach m $allmsgs {
242 delete $m
243 }
244 return ""
245 }
246 set lasttag $ret
247
248 switch $tag {
249 v {
250 set media ""
251 set msg [new SDPMessage]
252 lappend allmsgs $msg
253 $msg set version_ $value
254 }
255 o {
256 if {![info exists msg]} {
257 set media ""
258 set msg [new SDPMessage]
259 lappend allmsgs $msg
260 $msg set version_ 0
261 set tmp [$msg set msgtext_]
262 lappend tmp "v=0"
263 $msg set msgtext_ $tmp
264 }
265 $msg set creator_ [lindex $value 0]
266 $msg set createtime_ [lindex $value 1]
267 $msg set modtime_ [lindex $value 2]
268 $msg set nettype_ [lindex $value 3]
269 $msg set addrtype_ [lindex $value 3]
270 $msg set createaddr_ [lindex $value 5]
271 }
272 s {
273 $msg set session_name_ $value
274 }
275 i {
276 if { $media != "" } {
277 $media set session_info_ $value
278 } else {
279 $msg set session_info_ $value
280 }
281 }
282 p {
283 set tmp ""
284 catch { set tmp [$msg set phonelist_] }
285 lappend tmp $value
286 $msg set phonelist_ $tmp
287 }
288 e {
289 set tmp ""
290 catch { set tmp [$msg set emaillist_] }
291 lappend tmp $value
292 $msg set emaillist_ $tmp
293 }
294 u {
295 $msg set uri_ $value
296 }
297 c {
298 if { $media != "" } {
299 $media set nettype_ [lindex $value 0]
300 $media set addrtype_ [lindex $value 1]
301 $media set caddr_ [lindex $value 2]
302 } else {
303 $msg set nettype_ [lindex $value 0]
304 $msg set addrtype_ [lindex $value 1]
305 $msg set caddr_ [lindex $value 2]
306 }
307 }
308 b {
309 set bwspec [split $value :]
310 if { $media != "" } {
311 $media set bwmod_ [lindex $bwspec 0]
312 $media set bwval_ [lindex $bwspec 1]
313 } else {
314 $msg set bwmod_ [lindex $bwspec 0]
315 $msg set bwval_ [lindex $bwspec 1]
316 }
317 }
318 t {
319 set tdes [new SDPTime]
320 $tdes set fields_(t) $value
321 $tdes set starttime_ [lindex $value 0]
322 $tdes set endtime_ [lindex $value 1]
323 set tmp [$msg set alltimedes_]
324 lappend tmp $tdes
325 $msg set alltimedes_ $tmp
326 }
327 r {
328 $tdes set fields_(r) $value
329 $tdes set repeat_interval_ [lindex $value 0]
330 $tdes set active_duration_ [lindex $value 1]
331 $tdes set offlist_ [lrange $value 2 end]
332 }
333 z {
334 set nval [llength $value]
335 # even?
336 if [expr 2 * ($nval / 2) != $nval] {
337 foreach m $allmsgs {
338 delete $m
339 }
340 return ""
341 }
342 $self instvar zoneinfo_
343 for { set n 0 } { $n < $nval } { incr n } {
344 set adjtime [lindex $value $n]
345 incr n
346 set offset [lindex $value $n]
347 lappend zoneinfo_ "$adjtime $offset"
348 }
349 }
350 k {
351 set tmp [split $value :]
352 if { $media != "" } {
353 $media set crypt_method_ [lindex $tmp 0]
354 $media set crypt_key_ [lindex $tmp 1]
355 } else {
356 $msg set crypt_method_ [lindex $tmp 0]
357 $msg set crypt_key_ [lindex $tmp 1]
358 }
359 }
360 a {
361 set attribute [split $value ":"]
362 set attname [lindex $attribute 0]
363 # set attval [lindex $attribute 1]
364 set attval [join [lrange $attribute 1 end] ":"]
365 if { $media != "" } {
366 set target $media
367 } else {
368 set target $msg
369 }
370 if [catch {$target set attributes_($attname)}] {
371 $target set attributes_($attname) {}
372 }
373 $target set attributes_($attname) \
374 [concat [$target set attributes_($attname)] \
375 [list $attval]]
376 }
377 m {
378 set media [new SDPMedia $msg]
379 set mt [lindex $value 0]
380 $media set mediatype_ $mt
381 $media set port_ [lindex $value 1]
382 $media set proto_ [lindex $value 2]
383 $media set fmt_ [lrange $value 3 end]
384
385 set tmp ""
386 catch { set tmp [$msg set media_array_($mt)] }
387 lappend tmp $media
388 $msg set media_array_($mt) $media
389
390 set tmp [$msg set allmedia_]
391 lappend tmp $media
392 $msg set allmedia_ $tmp
393 }
394
395 default {
396 set parse_error_ "$class: error unknown modifier $tag."
397 foreach m $allmsgs {
398 delete $m
399 }
400 return ""
401 }
402 }
403
404 set tmp [$msg set msgtext_]
405 lappend tmp $line
406 $msg set msgtext_ $tmp
407
408 if { $media != "" && [regexp {[icbka]} $tag] } {
409 $media set fields_($tag) $value
410 } else {
411 $msg set fields_($tag) $value
412 }
413 }
414
415 foreach msg $allmsgs {
416 set tmp [$msg set msgtext_]
417 set tmp [join $tmp \n]
418 append tmp \n
419 $msg set msgtext_ $tmp
420 }
421 return $allmsgs
422 }
423
424
425 #-------------------------------------------------------------------
426 # Method:
427 # SDPParser parse_error
428 # Description:
429 # Retrieve the error message we get when parsing.
430 #-------------------------------------------------------------------
431 SDPParser instproc parse_error { } {
432 return [$self set parse_error_]
433 }
434
435
436 #-------------------------------------------------------------------
437 # Class:
438 # SDPMessage
439 # Description:
440 # This class defines a single Session Description Protocol (SDP)
441 # message.
442 # See Also:
443 # SDPParser
444 #-------------------------------------------------------------------
445 Class SDPMessage
446
447 #-------------------------------------------------------------------
448 # Method:
449 # SDPMessage init
450 # Description:
451 # Initializes members.
452 #-------------------------------------------------------------------
453 SDPMessage instproc init {} {
454 $self next
455 $self instvar allmedia_ alltimedes_ msgtext_
456 set allmedia_ ""
457 set alltimedes_ ""
458 set msgtext_ ""
459 }
460
461
462 #-------------------------------------------------------------------
463 # Method:
464 # SDPMessage destroy
465 # Description:
466 # Deletes all medias.
467 #-------------------------------------------------------------------
468 SDPMessage instproc destroy {} {
469 $self instvar allmedia_ alltimedes_
470 foreach m $allmedia_ {
471 delete $m
472 }
473 foreach t $alltimedes_ {
474 delete $t
475 }
476 $self next
477 }
478
479
480 #-------------------------------------------------------------------
481 # Method:
482 # SDPMessage media
483 # Description:
484 # Return a list of all SDPMedia object for media type $media_type.
485 #-------------------------------------------------------------------
486 SDPMessage instproc media { media_type } {
487 $self instvar media_array_
488 if [info exists media_array_($media_type)] {
489 return $media_array_($media_type)
490 } else {
491 return ""
492 }
493 }
494
495
496 #-------------------------------------------------------------------
497 # Method:
498 # SDPMessage all_media
499 # Description:
500 # Return a list of all SDPMedia object.
501 #-------------------------------------------------------------------
502 SDPMessage instproc all_media { } {
503 $self instvar allmedia_
504 return $allmedia_
505 }
506
507
508 #-------------------------------------------------------------------
509 # Method:
510 # SDPMessage have_field
511 # Description:
512 # Returns 0 or 1 depending on whether field $field was present
513 # in the announcement, e.g., 'c', 'v', 'k', etc.
514 #-------------------------------------------------------------------
515 SDPMessage instproc have_field { field } {
516 $self instvar fields_
517 return [info exists fields_($field)]
518 }
519
520
521 #-------------------------------------------------------------------
522 # Method:
523 # SDPMessage field_value
524 # Description:
525 # Returns the value of the field $field, empty if it doesn't exist.
526 #-------------------------------------------------------------------
527 SDPMessage instproc field_value { field } {
528 $self instvar fields_
529 if [info exists fields_($field)] {
530 return $fields_($field)
531 } else {
532 return ""
533 }
534 }
535
536
537 #-------------------------------------------------------------------
538 # Method:
539 # SDPMessage field_value
540 # Description:
541 # Returns a list of all attributes defined in the message.
542 #-------------------------------------------------------------------
543 SDPMessage instproc attributes {} {
544 $self instvar attributes_
545 if [info exists attributes_] {
546 return [array names attributes_]
547 } else {
548 return ""
549 }
550 }
551
552
553 #-------------------------------------------------------------------
554 # Method:
555 # SDPMessage have_attr
556 # Description:
557 # Returns 0 or 1 depending on whether attr $name exists in the
558 # message.
559 #-------------------------------------------------------------------
560 SDPMessage instproc have_attr { name } {
561 $self instvar attributes_
562 return [info exists attributes_($name)]
563 }
564
565
566 #-------------------------------------------------------------------
567 # Method:
568 # SDPMessage attr_value
569 # Description:
570 # Returns the value of attribute $name. If attribute $a does not
571 # exist, returns an empty list.
572 #-------------------------------------------------------------------
573 SDPMessage instproc attr_value { name } {
574 $self instvar attributes_
575 if [info exists attributes_($name)] {
576 return $attributes_($name)
577 } else {
578 return ""
579 }
580 }
581
582
583 #-------------------------------------------------------------------
584 # Method:
585 # SDPMessage obj2str
586 # Description:
587 # Returns a string SDP announcement from the object information.
588 #-------------------------------------------------------------------
589 SDPMessage instproc obj2str {} {
590 $self instvar attributes_ alltimedes_ allmedia_
591 set o "v=[$self field_value v]"
592 foreach f { o s i u } {
593 if [$self have_field $f] {
594 set n "$f=[$self field_value $f]"
595 set o $o\n$n
596 }
597 }
598 $self instvar phonelist_ emaillist_
599 if [info exists phonelist_] {
600 foreach e $phonelist_ {
601 set n "p=$e"
602 set o $o\n$n
603 }
604 }
605 if [info exists emaillist_] {
606 foreach e $emaillist_ {
607 set n "e=$e"
608 set o $o\n$n
609 }
610 }
611 foreach f { c b } {
612 if [$self have_field $f] {
613 set n "$f=[$self field_value $f]"
614 set o $o\n$n
615 }
616 }
617 foreach t $alltimedes_ {
618 set n [$t obj2str]
619 set o $o\n$n
620 }
621 foreach f { z k } {
622 if [$self have_field $f] {
623 set n "$f=[$self field_value $f]"
624 set o $o\n$n
625 }
626 }
627 foreach a [$self attributes] {
628 if { $attributes_($a) == "" } {
629 set n "a=$a"
630 } else {
631 set n "a=$a:$attributes_($a)"
632 }
633 set o $o\n$n
634 }
635 foreach m $allmedia_ {
636 set n [$m obj2str]
637 set o $o\n$n
638 }
639
640 return $o
641 }
642
643 # generate a string that serves as a unique key for this
644 # announcement (and remains the same even for modified
645 # versions of this announcement).
646 SDPMessage public unique_key {} {
647 if ![$self have_field o] {
648 $self warn "in SDPMessage::unique_key without o= field"
649 return ""
650 }
651 set l [split [$self field_value o]]
652 # get rid of version
653 catch {set l [lreplace $l 2 2]}
654 set key [join $l :]
655 return $key
656 }
657
658
659 SDPMessage instproc htmlify_media { } {
660 set html {}
661 foreach media [$self set allmedia_] {
662 append html [$media create_dynamic_html \
663 [DynamicHTMLifier set html_(media)]]
664 }
665 return $html
666 }
667
668
669 SDPMessage instproc htmlify_times { {single_line 0} } {
670 set html {}
671 if $single_line { set t time1 } else { set t time }
672 foreach time [$self set alltimedes_] {
673 set repeat [string tolower [$time readable_repeat]]
674 if { [$time set starttime_] != 0 } {
675 append html [$time create_dynamic_html \
676 [DynamicHTMLifier set html_(${t}_$repeat)]]
677
678 } else {
679 append html "Unbounded session"
680 }
681 }
682 return $html
683 }
684
685
686 SDPMessage instproc htmlify_url { } {
687 $self instvar uri_
688 if [info exists uri_] {
689 return "<a href=\"$uri_\">$uri_</a>"
690 } else {
691 return ""
692 }
693 }
694
695
696 SDPMessage instproc htmlify_list { varname } {
697 set list {}
698 foreach elt [$self get $varname] {
699 if { $list!={} } {
700 append list ", $elt"
701 } else {
702 append list $elt
703 }
704 }
705 return $list
706 }
707
708
709 SDPMessage instproc get { varname } {
710 $self instvar $varname
711 if [info exists $varname] {
712 return [set $varname]
713 } else {
714 return ""
715 }
716 }
717
718
719 SDPMedia instproc htmlify_mediatype { } {
720 return "[$self set mediatype_]"
721 }
722
723
724 SDPMedia instproc get { varname } {
725 $self instvar $varname
726 if [info exists $varname] {
727 return [set $varname]
728 } elseif { $varname == "spec_" } {
729 set caddr [split [$self get caddr_] /]
730 set port [$self get port_]
731 set spec [lindex $caddr 0]/$port
732 set ttl [lindex $caddr 1]
733 if { $ttl != {} } { append spec /$ttl }
734 return $spec
735 } else {
736 return ""
737 }
738 }
739
740
741 # pull in the global attributes
742 SDPMedia instproc init {{msg ""}} {
743 $self next
744
745 if {$msg == ""} { return }
746
747 $self instvar attributes_ fields_
748 set alist [$msg attributes]
749 foreach a $alist {
750 set attributes_($a) [$msg set attributes_($a)]
751 }
752 set vlist [$msg info vars]
753 foreach f { session_info_ nettype_ addrtype_ caddr_ bwmod_ bwval_
754 crypt_method_ crypt_key_ } {
755 if { [lsearch -exact $vlist $f] >= 0 } {
756 $self set $f [$msg set $f]
757 }
758 }
759
760 foreach f { i c b k a } {
761 if [$msg have_field $f] {
762 set fields_($f) [$msg field_value $f]
763 }
764 }
765 }
766
767 SDPMedia instproc have_field { field } {
768 $self instvar fields_
769 return [info exists fields_($field)]
770 }
771
772 SDPMedia instproc field_value { field } {
773 $self instvar fields_
774 if [info exists fields_($field)] {
775 return $fields_($field)
776 } else {
777 return ""
778 }
779 }
780
781 SDPMedia instproc have_attr { name } {
782 $self instvar attributes_
783 return [info exists attributes_($name)]
784 }
785
786 SDPMedia instproc attr_value { name } {
787 $self instvar attributes_
788 if [info exists attributes_($name)] {
789 return $attributes_($name)
790 } else {
791 return ""
792 }
793 }
794
795 SDPMedia instproc attributes {} {
796 $self instvar attributes_
797 if [info exists attributes_] {
798 return [array names attributes_]
799 } else {
800 return ""
801 }
802 }
803
804 SDPMedia instproc obj2str {} {
805 $self instvar attributes_
806 set o "m=[$self field_value m]"
807 foreach f { i c b k } {
808 if [$self have_field $f] {
809 set n "$f=[$self field_value $f]"
810 set o $o\n$n
811 }
812 }
813 foreach a [array names attributes_] {
814 if { $attributes_($a) == "" } {
815 set n "a=$a"
816 } else {
817 set n "a=$a:$attributes_($a)"
818 }
819 set o $o\n$n
820 }
821 return $o
822 }
823
824 SDPTime instproc have_field { field } {
825 $self instvar fields_
826 return [info exists fields_($field)]
827 }
828
829 SDPTime instproc field_value { field } {
830 $self instvar fields_
831 if [info exists fields_($field)] {
832 return $fields_($field)
833 } else {
834 return ""
835 }
836 }
837
838 SDPTime instproc obj2str {} {
839 set o "t=[$self field_value t]"
840 if [$self have_field r] {
841 set n "r=[$self field_value r]"
842 set o $o\n$n
843 }
844 return $o
845 }
846
847
848 SDPTime public get { varname } {
849 $self instvar $varname
850 if [info exists $varname] {
851 return [set $varname]
852 } else {
853 return ""
854 }
855 }
856
857
858 #
859 # Returns the number of seconds between time_type (i.e. starttime_ or
860 # endtime_) and the current time. Note that the number of seconds
861 # returned will be negative if the current time is past the time
862 # specified by time_type.
863 #
864 SDPTime public sec_until_current { time_type } {
865 set sdp_time [ntp_to_unix [$self get $time_type]]
866 set current [clock seconds]
867 return [expr $sdp_time - $current]
868 }
869
870
871 SDPTime public current_in_interval { start end } {
872
873 set current [unix_to_ntp [clock seconds]]
874
875 if { [expr $start == 0 && $end == 0] } {
876 # Both start and end are unbounded.
877 return 1
878
879 } elseif { $start == 0 } {
880 # Start is unbounded; check that current is less than end.
881 return [expr $end > $current]
882
883 } elseif { $end == 0 } {
884 # End is unbounded; check that current is greater than start.
885 return [expr $start <= $current]
886
887 } else {
888 # Neither start nor end are unbounded; check that current is
889 # in the range.
890 return [expr $start <= $current && $end > $current]
891 }
892 }
893
894
895 #
896 # Returns the time associated with time_type in a readable format:
897 # [Hour in 24-hour format]:[Minute].
898 #
899 SDPTime public readable_time { time_type } {
900 set sec [ntp_to_unix [$self get $time_type]]
901 if { $sec == 0 } {
902 return *unbounded*
903 } else {
904 return [clock format $sec -format {%H:%M}]
905 }
906 }
907
908
909 #
910 # Returns the duration in a readable format: [Hours]:[Minute].
911 #
912 SDPTime public readable_duration { } {
913 set duration [$self get active_duration_]
914
915 set hours [expr $duration / 3600]
916 if { $hours < 24 } {
917 return "$hours hour(s)"
918 }
919
920 set days [expr $hours / 24]
921 if { $days < 7 } {
922 return "$days day(s)"
923 }
924
925 set weeks [expr $days / 7]
926 return "$weeks week(s)"
927 }
928
929
930 #
931 # Returns the date associated with time_type in a readable format:
932 # [Date] [Month] [Year].
933 #
934 SDPTime public readable_date { time_type {numonly 0} } {
935 set sec [ntp_to_unix [$self get $time_type]]
936 if { $sec == 0 } {
937 return *unbounded*
938 } elseif $numonly {
939 return [clock format $sec -format {%m/%d/%y}]
940 } else {
941 return [clock format $sec -format {%B %d, %Y}]
942 }
943 }
944
945
946 #
947 # Returns the day of the week associated with time_type in a
948 # readable format.
949 #
950 SDPTime public readable_day { time_type } {
951 set sec [ntp_to_unix [$self get $time_type]]
952 if { $sec == 0 } {
953 return *unbounded*
954 } else {
955 return [clock format $sec -format {%a}]
956 }
957 }
958
959
960 #
961 # Returns the day of the week associated with time_type in a
962 # readable format.
963 #
964 SDPTime public readable_day_full { time_type } {
965 set sec [ntp_to_unix [$self get $time_type]]
966 if { $sec == 0 } {
967 return *unbounded*
968 } else {
969 return [clock format $sec -format {%A}]
970 }
971 }
972
973
974 #
975 # Returns the zone assocated with time_type in a readable format.
976 #
977 SDPTime public readable_zone { time_type } {
978 set sec [ntp_to_unix [$self get $time_type]]
979 return [clock format $sec -format {%Z}]
980 }
981
982
983 #
984 # Returns the repeat interval in a readable format.
985 #
986 SDPTime public readable_repeat { } {
987
988 set interval [$self get repeat_interval_]
989
990 if { $interval == 86400 } {
991 return Daily
992 } elseif { $interval == 604800 } {
993 return Weekly
994 } else {
995 return None
996 }
997 }
998
999
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.