use XML::DOM;

my (%component_id_tag, %bond_id_start_id, %bond_id_end_id,
    %component_label_data, $objects, %mtt_bond_id_index,
    %bond_id_arrow_on_start, %bond_id_flow_causality, %bond_id_effort_causality,
    %bond_id_start_label,%bond_id_end_label);

my (%component_id_type, %component_id_name, %component_id_reps, %component_id_anon);

# Parse user options:
my $diagram_name = '';
my $dia_input_file = '';
my $dia_output_file = '';
my $label_file = '';
my $component_list_file = '';
my $debug = 0;

my $dom = new XML::DOM::Parser;
my ($doc);

$doc = $dom->parsefile($dia_input_file);
$objects = get_objects_node($doc,"Bond Graph");

get_component_data($objects);
parse_component_data();

get_bond_data($objects);

create_component_list() if ($create_component_list);
name_anonymous_components();

if ($create_abg) {
    open (OUT,">$abg_file") ||
	die "Cannot open $abg_file for writing.\n";

    # Don't update the label file unless we are creating component list and abg simultaneously...
    if ($create_component_list) {

sub create_component_list {
    my ($type, $name);

    print_debug("CREATING unique_raw_list...\n");
    open (RAW,">$component_list_file") ||
	die "Cannot open $component_list_file for writing.\n";

    my (%reverse_component_id_tag) = reverse (%component_id_tag);
    foreach my $val (values(%component_id_tag)) {	
	my ($id, $type);
	$id = $reverse_component_id_tag{$val};
	$type = $component_id_type{$id};
	$_ = $val;
	id_cleaner();
	$val = $_;
	$val =  $_;
	($type, $name) = split (/:/) ;
	$type = $type ? $type : $val;
	print RAW $val . "\n" if (($type ne "1") and ($type ne "0"));
    }
    close(RAW);
}


sub get_label_data {

}

sub output_abg {
    my ($cr,$rep,$stat,$NM,$type,$arg,$bond_id,$start,$end,@clist,$connections,
	$strlength,$subsys_or_port);

    print_debug("WRITING OUTPUT TO STDIO...\n");
    $rep = "1";
    $stat = "-1";

    output_abg_header();
    
    foreach my $id (keys(%component_id_tag)) {
	($subsys_or_port,$_) = id_to_name($id);
	remove_brackets(); $NM = $_;

	$type = id_to_type($id);
	$type = $component_id_type{$id};

	$cr = "" unless defined($cr = $component_label_data{$NM}[1]);
	$arg = "" unless defined($arg = $component_label_data{$NM}[2]);
	$rep = $component_id_reps{$id};

	@clist = ();
	while (($bond_id,$start) = each(%bond_id_start_id)) {
	    push(@clist, ($bond_id_arrow_on_start{$bond_id} ? -1 : 1) *
		 $mtt_bond_id_index{$bond_id}) if $start eq $id;
	}
	while (($bond_id,$end) = each(%bond_id_end_id)) {

	$head_label,$tail_label,
	$effort_causality,$flow_causality);

    output_ibg_header();

    %reverse_mtt_bond_id_index = reverse (%mtt_bond_id_index);

#    while (($mtt_bond_id, $dia_bond_id) = each(%reverse_mtt_bond_id_index)) {
    @bonds = (sort keys (%reverse_mtt_bond_id_index));
    foreach $mtt_bond_id (@bonds) {
 
	$dia_bond_id = $reverse_mtt_bond_id_index{$mtt_bond_id};

	$start = $bond_id_start_id{$dia_bond_id};
	$end   = $bond_id_end_id  {$dia_bond_id};

	if ($start_label !~  /\[.*\]/) {
	    $start_label = "[]";
	}
	if ($end_label !~ /\[.*\]/) {
	    $end_label = "[]";
	}

	# ignore label if it is not enclosed by []
#	$start_label =~ s/[^[]*\[\([^]]*\)\]/[$1]/;
#	$end_label   =~ s/[^[]*\[\([^]]*\)\]/[$1]/;

	if ($bond_id_arrow_on_start{$dia_bond_id}) {
	    $head_label = $end_label;
	    $tail_label = $start_label;
	} else {
	    $head_label = $start_label;
	    $tail_label = $end_label;
	}

	$head_component = $component_id_tag{$head};
	$tail_component = $component_id_tag{$tail};
	$head_component = "$component_id_type{$head}:$component_id_name{$head}";
	$tail_component = "$component_id_type{$tail}:$component_id_name{$tail}";

	$effort_causality = $bond_id_effort_causality{$dia_bond_id};
	$flow_causality   = $bond_id_flow_causality  {$dia_bond_id};

	for ($effort_causality) {
	    if (/-1/) { $effort_causality = "tail";}
	    if (/0/) { $effort_causality = "none";}

      $str_elem = get_first_element_subnode($strattr);
      $string = get_first_text_subnode($str_elem);
      $component_id_tag{$id} = $string->getData;
  }
    die "There are no components!\n" unless keys(%component_id_tag) > 0;
}

sub name_anonymous_components {
    my ($id, $component, $type, $name, $anon_id);
    $anon_id = 0;
    while (($id, $component) = each(%component_id_tag)) {
sub parse_component_data {
    my ($anon_index, $id, $component, $anonymous);
    $anon_index = 0;
    while (($id, $component) = each (%component_id_tag)) {
	$_ = $component;
	id_cleaner();
	$component = $_;
	my ($type_name, $repetitions) = split (/\*/, $component);
	if (! $repetitions) {
	    $type_name = $component;
	    $repetitions = 1;
	}
	($type, $name) = split (/:/, $component);
	my ($type, $name) = split (/:/, $type_name);
	if (! $name) {
	    $type = $type_name;
	    $component = "${component}:mtt${component}_${anon_id}";
	    $anon_id++;
	    $name = "mtt${type}_${anon_index}";
	    $anonymous = 1;
	    $anon_index++;
	} else {
	    $anonymous = 0;
	}
	$component_id_tag{$id} = $component;
    }    
	$component_id_type{$id} = $type;
	$component_id_name{$id} = $name;
	$component_id_reps{$id} = $repetitions;
	$component_id_anon{$id} = $anonymous;
    }
}

# Dia stores its attributes in a strange way, not using typical xml attributes.
sub get_dia_attribute_value {
    my ($type, $attribute_node )= @_;
    my ($subnode);
    $subnode = get_first_subnode_by_nodename_attribute(0,$attribute_node,$type);

    s/#?([^#]*)#?/$1/;
}

sub remove_brackets {
    s/^\[([^\]]*)\]$/$1/;
}

sub id_to_type {
    my ( $id )= @_;
    my($type,$name);

    $_ = $component_id_tag{$id};
    id_cleaner();
    ($type, $name) = split(/:/);

    return $type;
}

# If 1 LHS argument is used, it returns component name.  If 2 are used, it return
# "subsystem" or "port" depending on whether brackets are found in the name.
sub id_to_name {
    my ( $id )= @_;
    my($type,$name);

    $_ = $component_id_tag{$id};
    
    $type = $component_id_type{$id};
    id_cleaner();
    ($type, $name) = split(/:/);
    $name = $component_id_name{$id};

    if(!defined($name)) { $name = $id };

    return ( ($name =~ /^\[[^\]]*\]$/ ? "ports" : "subsystems" ),$name);
}

sub print_debug {