#!/usr/bin/env tclsh

while {[gets stdin line] >= 0} {
  if {[scan $line {%s %s bags contain %[^.].} c1 c2 rest] != 3} continue
  set color "$c1 $c2"
  if {$rest eq "no other bags"} {
    set contain($color) {}
    continue
  }
  set words [split $rest { }]
  while {[llength $words]} {
    set c2 "[lindex $words 1] [lindex $words 2]"
    lappend contain($color) $c2
    lappend canbein($c2) $color
    set words [lrange $words 4 end]
  }
}

proc holders {bag} {
  global canbein
  if {! [info exists canbein($bag)]} {return {}}
  set h $canbein($bag)
  foreach b $canbein($bag) {
    lappend h {*}[holders $b]
  }
  return [lsort -unique $h]
}

set h [holders {shiny gold}]
puts $h
puts [llength $h]