Overview
Comment:Removed functions associated with writing _abg.m directly.
dia2abg.pl now produces _ibg.m instead.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | origin/master | trunk
Files: files | file ages | folders
SHA3-256: d5745021a6ec218664d70d8eab4559074c8a54530af6350e5b782e51a6f52410
User & Date: geraint@users.sourceforge.net on 2004-08-19 19:17:41
Other Links: branch diff | manifest | tags
Context
2004-08-19
19:33:43
Sorts component list into alphabetical order to improve default lbl.txt generation. check-in: f3ad0d9295 user: geraint@users.sourceforge.net tags: origin/master, trunk
19:17:41
Removed functions associated with writing _abg.m directly.
dia2abg.pl now produces _ibg.m instead.
check-in: d5745021a6 user: geraint@users.sourceforge.net tags: origin/master, trunk
19:14:11
File removed: abg2ibg_dia2m is now used instead. check-in: 9c56eaad07 user: geraint@users.sourceforge.net tags: origin/master, trunk
Changes

Modified mttroot/mtt/bin/trans/dia2abg.pl from [9fb297b3c3] to [f8b9be78d9].

1
2
3
4
5

6
7
8
9
10
11
12
#!/usr/bin/perl -w

#----------------------------------------------------------------------------
# dia2abg.pl
# Copyright (C) 2002; David Hoover.

#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,





>







1
2
3
4
5
6
7
8
9
10
11
12
13
#!/usr/bin/perl -w

#----------------------------------------------------------------------------
# dia2abg.pl
# Copyright (C) 2002; David Hoover.
# Modified      2004  Geraint Bevan.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
# For more information about free software, visit http://www.fsf.org/
#----------------------------------------------------------------------------

#############################################################################
# Given a DIA diagram, the script has functions that perform the following
# MTT (model transformation tools) functions:
# 1. Write a _cmp.txt file containing component types:names
# 2. Write a _abg.m file containing an acausal bond graph suitable for input
#    to Octave.
# 3. Modify a diagram by changing causality as desired.
#############################################################################

#----------------------------------------------------------------------------
# Dia uses a unique id for each object.
# get_component_data and get_bond_data read the xml file and collect
# important information about component and bond id's, component







|
|







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
# For more information about free software, visit http://www.fsf.org/
#----------------------------------------------------------------------------

#############################################################################
# Given a DIA diagram, the script has functions that perform the following
# MTT (model transformation tools) functions:
# 1. Write a _cmp.txt file containing component types:names
# 2. Write a _ibg.m file containing an acausal bond graph suitable for 
#    processing by MTT.
# 3. Modify a diagram by changing causality as desired.
#############################################################################

#----------------------------------------------------------------------------
# Dia uses a unique id for each object.
# get_component_data and get_bond_data read the xml file and collect
# important information about component and bond id's, component
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
# The %bond_id_flow_causality hash is a boolean that provides the
# flow arrow-oriented causality.
#
# key=bond_id
# value=arrow-oriented flow causality.

# %mtt_bond_id_index provides a unique positive integer index for each
# Dia bond ID.  The index is written to the abg.m file for mtt.

# The %component_label_data hash is a hash of arrays.


# key=column 1 of label file

# value=list(order in label file, col1 of lbl file, col2 of lbl file, ...)
#----------------------------------------------------------------------------

#----------------------------MAIN PROGRAM------------------------------------
use strict;
use Getopt::Long;
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 $create_component_list = 0;
my $create_abg = 0;
my $create_ibg = 0;
my $abg_file = '';
my $ibg_file = '';
my $change_flow_causality = '';
my $change_effort_causality = '';
GetOptions ('diagram_name=s' => \$diagram_name,
	    'dia_input_file=s' => \$dia_input_file,
	    'dia_output_file=s' => \$dia_output_file,
	    'label_file=s' => \$label_file,
	    'component_list_file=s' => \$component_list_file,
	    'debug' => \$debug,
	    'create_component_list' => \$create_component_list,
	    'create_abg' => \$create_abg,
	    'create_ibg' => \$create_ibg,
	    'abg_file=s' => \$abg_file,
	    'ibg_file=s' => \$ibg_file,
	    'change_flow_causality=s' => \$change_flow_causality,
	    'change_effort_causality=s' => \$change_effort_causality,
	    );

die usage() if $diagram_name eq '';

# Use defaults if necessary:
$dia_input_file = $diagram_name . "_abg.dia" if ($dia_input_file eq '');
$dia_output_file = $diagram_name . "_cbg.dia" if ($dia_output_file eq '');
$label_file = $diagram_name . "_lbl.txt" if ($label_file eq '');
$abg_file = $diagram_name . "_abg.m" if ($abg_file eq '');
$ibg_file = $diagram_name . "_ibg.m" if ($ibg_file eq '');
$component_list_file = $diagram_name . "_cmp.txt" if ($component_list_file eq '');

# Start Parsing XML, and creating files:
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);

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) {
	print STDERR "WARNING: Label file may be stale.\n" 
	#system("abg2lbl_fig2txt -c $component_list_file $diagram_name") &&
	#system("abg2lbl_fig2txt -x $diagram_name") && die "abg2lbl_fig2txt failed.";
    }

    get_label_data();
    output_abg();
    output_bond_causality();
    parse_aliases();
    print OUT "endfunction\n";
}

if ($create_ibg) {
    open (OUT,">$ibg_file") ||
	die "Cannot open $ibg_file for writing.\n";
    # don't bother about creating cmp.m simultaneously
    # don't need getting label data
    output_ibg();
    
}   

if ($change_flow_causality ne '' || $change_effort_causality ne '') {
    open (DIA_OUT,">$dia_output_file") ||
	die "Cannot open $dia_output_file for writing.\n";







|

|
>
|
|
>
|








|



|


|
|
|
<
|
|
|
<
|
<
|
|
|
|
|
|
<
|
|
|
<
|
<
|
|
|





|
|
<
<
|
















<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<



<
<







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
# The %bond_id_flow_causality hash is a boolean that provides the
# flow arrow-oriented causality.
#
# key=bond_id
# value=arrow-oriented flow causality.

# %mtt_bond_id_index provides a unique positive integer index for each
# Dia bond ID.  The index is written to the ibg.m file for mtt.

# The %component_id_type, %component_id_name, %component_id_reps hashes
# store the information from _cmp.m for each component
#
# key=component_id
# value=component type, name or number of repetitions

#----------------------------------------------------------------------------

#----------------------------MAIN PROGRAM------------------------------------
use strict;
use Getopt::Long;
use XML::DOM;

my (%component_id_tag, %bond_id_start_id, %bond_id_end_id,
    $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);

# Parse user options:
my $diagram_name		= '';
my $dia_input_file		= '';
my $dia_output_file		= '';

my $component_list_file		= '';
my $debug			= 0;
my $create_component_list	= 0;

my $create_ibg			= 0;

my $ibg_file			= '';
my $change_flow_causality	= '';
my $change_effort_causality	= '';
GetOptions ('diagram_name=s'		=> \$diagram_name,
	    'dia_input_file=s'		=> \$dia_input_file,
	    'dia_output_file=s'		=> \$dia_output_file,

	    'component_list_file=s'	=> \$component_list_file,
	    'debug'			=> \$debug,
	    'create_component_list'	=> \$create_component_list,

	    'create_ibg'		=> \$create_ibg,

	    'ibg_file=s'		=> \$ibg_file,
	    'change_flow_causality=s'	=> \$change_flow_causality,
	    'change_effort_causality=s'	=> \$change_effort_causality,
	    );

die usage() if $diagram_name eq '';

# Use defaults if necessary:
$dia_input_file      = $diagram_name . "_abg.dia" if ($dia_input_file      eq '');
$dia_output_file     = $diagram_name . "_cbg.dia" if ($dia_output_file     eq '');


$ibg_file            = $diagram_name . "_ibg.m"   if ($ibg_file            eq '');
$component_list_file = $diagram_name . "_cmp.txt" if ($component_list_file eq '');

# Start Parsing XML, and creating files:
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);



















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


    output_ibg();
    
}   

if ($change_flow_causality ne '' || $change_effort_causality ne '') {
    open (DIA_OUT,">$dia_output_file") ||
	die "Cannot open $dia_output_file for writing.\n";
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
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
	id_cleaner();
	$val =  $_;
	print RAW $val . "\n";
    }
    close(RAW);
}


sub get_label_data {
    my ($name,@line,$i);

    print_debug("READING DATA FROM $label_file...\n");
    open (LBL,$label_file) || die "Cannot open label file: $label_file\n";

    $i=0;
    while (<LBL>) {
      chomp;
      # Get rid of commented lines:
      next if (/^(\s)*[%\#]/);
      # Get rid of empty or whitespace-only lines:
      next if (/^(\s)*$/);
      # Get rid of leading/trailing whitespace:
      s/^\s*(\S.+\S)\s*$/$1/;

      print_debug("label: $_ \n");      

      @line = split(/\s+/);
      $name = shift(@line);

      $component_label_data{$name} = [ ($i++,@line) ];
  }
    close(LBL);
}

sub parse_aliases {
    my ($name,@line,$alias);

    print OUT "# Aliases\n";
    print OUT "# A double underscore __ represents a comma\n";

    open (LBL,$label_file) || die "Cannot open label file: $label_file\n";

    while (<LBL>) {
      chomp;
      # Get rid of everything except ALIAS lines:
      next unless (s/^[%\#]ALIAS(.*)$/$1/);
      # Get rid of leading/trailing whitespace:
      s/^\s*(\S.+\S)\s*$/$1/;

      @line = split(/\s+/);
      die "Label file ALIAS entries must have 2 columns!\n" unless
	  @line == 2;

      print OUT "$diagram_name.alias.$line[1] = \"$line[0]\";\n";
  }
    close(LBL);
    print OUT "## Port domain and units\n";
    print OUT "## Explicit variable declarations\n";
}

sub get_objects_node {
    my ( $doc_node, $layer_name )= @_;
    my ($root,$layer_node,$objects);

    $root = get_first_element_subnode($doc_node);
    die "could not find top-level element dia_diagram.\n"
	unless $root->getTagName eq 'dia:diagram';
    
    $layer_node = get_first_subnode_by_nodename_attribute(0,$root,"dia:layer","name",$layer_name);
    die "I found no dia:layer named $layer_name.  Are you sure the diagram has one?\n" unless
	$layer_node->getTagName eq 'dia:layer' &&
	$layer_node->getAttributeNode("name")->getValue eq $layer_name;
    
    $objects = $layer_node->getElementsByTagName('dia:object');

    return $objects;
}

sub output_abg_header {
    my ($date);
    $date = `date`; chomp($date);

    print OUT <<"EOF";
function [${diagram_name}] =  ${diagram_name}_abg
# This function is the acausal bond graph representation of $diagram_name
# Generated by dia2abg.pl on $date
# The file is in Octave format

# Subsystems and Ports

EOF
}

sub output_ibg_header {
    my ($date);
    $date = `date`; chomp($date);

    print OUT <<"EOF";
## -*-octave-*- put Emacs into Octave mode








<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


















<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







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
	id_cleaner();
	$val =  $_;
	print RAW $val . "\n";
    }
    close(RAW);
}






















































sub get_objects_node {
    my ( $doc_node, $layer_name )= @_;
    my ($root,$layer_node,$objects);

    $root = get_first_element_subnode($doc_node);
    die "could not find top-level element dia_diagram.\n"
	unless $root->getTagName eq 'dia:diagram';
    
    $layer_node = get_first_subnode_by_nodename_attribute(0,$root,"dia:layer","name",$layer_name);
    die "I found no dia:layer named $layer_name.  Are you sure the diagram has one?\n" unless
	$layer_node->getTagName eq 'dia:layer' &&
	$layer_node->getAttributeNode("name")->getValue eq $layer_name;
    
    $objects = $layer_node->getElementsByTagName('dia:object');

    return $objects;
}
















sub output_ibg_header {
    my ($date);
    $date = `date`; chomp($date);

    print OUT <<"EOF";
## -*-octave-*- put Emacs into Octave mode

313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459

sub output_ibg_footer {
    print OUT <<"EOF";
endfunction
EOF
}

sub output_component {
    my ($NM,$type,$cr,$arg,$rep,$stat,$connections,$subsys_or_port) = @_;

    $_=$NM; remove_brackets(); $NM = $_;

    my $pretty_name = ($subsys_or_port eq "ports") ? "Port" : "Component";

	print OUT <<"EOF";
# $pretty_name $NM
  ${diagram_name}.${subsys_or_port}.${NM}.type = "$type";
  ${diagram_name}.${subsys_or_port}.${NM}.cr = "$cr";
  ${diagram_name}.${subsys_or_port}.${NM}.arg = "$arg";
  ${diagram_name}.${subsys_or_port}.${NM}.repetitions = $rep;
  ${diagram_name}.${subsys_or_port}.${NM}.status = $stat;
  ${diagram_name}.${subsys_or_port}.${NM}.connections = [$connections];
    
EOF
}

sub sort_components {
    my ($type1, $str1, $subsys_or_port1,
	$type2, $str2, $subsys_or_port2,
	$retval);
    
    $type1 = $component_id_type{$a};
    $type2 = $component_id_type{$b};

    $str1 = $component_id_tag{$a};
    $str2 = $component_id_tag{$b};

    ($subsys_or_port1, $_) = id_to_name($a);
    ($subsys_or_port2, $_) = id_to_name($b);

    print "${str1}: ${subsys_or_port1}\n";
    print "${str2}: ${subsys_or_port2}\n";

    # 1 junctions go last
    if (($type1 eq '1') and ($type2 ne '1')) {
	$retval = +1;
    } elsif (($type1 ne '1') and ($type2 eq '1')) {
	$retval = -1;
    # 0 junctions go before them
    } elsif (($type1 eq '0') and ($type2 ne '0')) {
	$retval = +1;
    } elsif (($type1 ne '0') and ($type2 eq '0')) {
	$retval = -1;
    # ports go first
    } elsif (($subsys_or_port1 ne 'ports') and
	     ($subsys_or_port2 eq 'ports')) {
	$retval = +1;
    } elsif (($subsys_or_port1 eq 'ports') and
	     ($subsys_or_port2 ne 'ports')) {
	$retval = -1;
    # sort by type:name
    } else {
	$retval = ($str1 cmp $str2);
    }

    return $retval;
}

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");
    $stat = "-1";

    output_abg_header();
    
    # order component id's alphabetically by (type:name)
    my (@id_list);
    @id_list = keys (%component_id_tag);
    @id_list = sort sort_components @id_list;

    foreach my $id (@id_list) {
	($subsys_or_port,$_) = id_to_name($id);
	remove_brackets(); $NM = $_;

	$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)) {
	    
	    push(@clist, ($bond_id_arrow_on_start{$bond_id} ? 1 : -1) *
		 $mtt_bond_id_index{$bond_id}) if $end eq $id;
	}
	$connections = join(" ",@clist);

	output_component($NM,$type,$cr,$arg,$rep,$stat,$connections,$subsys_or_port);
    }
    
    # calculate string length of longest component name (for octave):
    $strlength=0;
    foreach my $id (@id_list) {
	my $name = id_to_name($id);
	$strlength = length($name) if length($name) > $strlength;
    };

    print OUT "# Ordered list of Port names\n";
    my $i=1;
    foreach my $id (@id_list) {
	my ($subsys_or_port,$name) = id_to_name($id);
	if ($subsys_or_port eq "ports") {
	    $_ = $name; remove_brackets(); $name = $_;
	    print OUT "  " . $diagram_name . ".portlist($i,:)" . ' = "'
		. $name . " " x ($strlength - length($name)) . '";' . "\n";
	    $i++;
	}
    }
    print OUT "\n";

    print OUT "# Ordered list of subsystem names\n";
    $i=1;
    foreach my $id (@id_list) {
	my ($subsys_or_port,$name) = id_to_name($id);
	if ($subsys_or_port eq "subsystems") {
	    print OUT "  " . $diagram_name . ".subsystemlist($i,:)" . ' = "'
		. $name . " " x ($strlength - length($name)) . '";' . "\n";
	    $i++;
	}
    }
    print OUT "\n";
}

sub output_ibg {
    my ($key,$component,$type,$name,
	%reverse_mtt_bond_id_index,$mtt_bond_id,$dia_bond_id,
	@bonds,
	$bond_id,$start,$end,$id,
	$head,$head_component,$head_type,$head_name,
	$tail,$tail_component,$tail_type,$tail_name,







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







220
221
222
223
224
225
226





































































































































227
228
229
230
231
232
233

sub output_ibg_footer {
    print OUT <<"EOF";
endfunction
EOF
}






































































































































sub output_ibg {
    my ($key,$component,$type,$name,
	%reverse_mtt_bond_id_index,$mtt_bond_id,$dia_bond_id,
	@bonds,
	$bond_id,$start,$end,$id,
	$head,$head_component,$head_type,$head_name,
	$tail,$tail_component,$tail_type,$tail_name,
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
	    "  ${diagram_name}.bonds.bond${mtt_bond_id_index{$dia_bond_id}}." .
	    "causality.flow = \"$flow_causality\";\n\n";
    }
    
    output_ibg_footer();
}

sub output_bond_causality {
    my ($mtt_bond_id,$dia_bond_id,$mtt_flow_causality,$mtt_effort_causality,
	%reverse_mtt_bond_id_index);

    print OUT "# Bonds\n";
    print OUT "  $diagram_name.bonds = [\n";

    %reverse_mtt_bond_id_index = reverse(%mtt_bond_id_index);

    while (($mtt_bond_id,$dia_bond_id) = each(%reverse_mtt_bond_id_index)) {
	$mtt_flow_causality = $bond_id_flow_causality{$dia_bond_id};
	$mtt_effort_causality = $bond_id_effort_causality{$dia_bond_id};

	print OUT "      $mtt_effort_causality $mtt_flow_causality\n";
    }
    print OUT "      ];\n\n";
}

sub get_component_data {
    my ( $objects_node )= @_;
    my($obj,$id,$attr,$comp,$strattr,$str_elem,$string);

    print_debug("READING COMPONENTS FROM $dia_input_file...\n");
    for my $i (0..$objects_node->getLength-1) {
      $obj = $objects_node->item($i);







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







310
311
312
313
314
315
316


















317
318
319
320
321
322
323
	    "  ${diagram_name}.bonds.bond${mtt_bond_id_index{$dia_bond_id}}." .
	    "causality.flow = \"$flow_causality\";\n\n";
    }
    
    output_ibg_footer();
}



















sub get_component_data {
    my ( $objects_node )= @_;
    my($obj,$id,$attr,$comp,$strattr,$str_elem,$string);

    print_debug("READING COMPONENTS FROM $dia_input_file...\n");
    for my $i (0..$objects_node->getLength-1) {
      $obj = $objects_node->item($i);
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
      $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 parse_component_data {
    my (%anon_index, $id, $component, $anonymous);

    while (($id, $component) = each (%component_id_tag)) {
	$_ = $component;
	id_cleaner();
	$component = $_;
	my ($type_name, $repetitions) = split (/\*/, $component);
	if (! $repetitions) {
	    $type_name = $component;
	    $repetitions = 1;
	}
	my ($type, $name) = split (/:/, $type_name);
	if (! $name) {
	    $type = $type_name;
	    if (! defined ($anon_index{$type})) {
		$anon_index{$type} = 1;
		$name = "mtt${type}";
	    } else {
		my $num = ++$anon_index{$type};
		$name = "mtt${type}_${num}";
	    }
	    $anonymous = 1;
	} else {
	    $anonymous = 0;
	}
	$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);







|




















<
<
<




<







333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360



361
362
363
364

365
366
367
368
369
370
371
      $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 parse_component_data {
    my (%anon_index, $id, $component);

    while (($id, $component) = each (%component_id_tag)) {
	$_ = $component;
	id_cleaner();
	$component = $_;
	my ($type_name, $repetitions) = split (/\*/, $component);
	if (! $repetitions) {
	    $type_name = $component;
	    $repetitions = 1;
	}
	my ($type, $name) = split (/:/, $type_name);
	if (! $name) {
	    $type = $type_name;
	    if (! defined ($anon_index{$type})) {
		$anon_index{$type} = 1;
		$name = "mtt${type}";
	    } else {
		my $num = ++$anon_index{$type};
		$name = "mtt${type}_${num}";
	    }



	}
	$component_id_type{$id} = $type;
	$component_id_name{$id} = $name;
	$component_id_reps{$id} = $repetitions;

    }
}

# Dia stores its attributes in a strange way, not using typical xml attributes.
sub get_dia_attribute_value {
    my ($type, $attribute_node )= @_;
    my ($subnode);
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
	$subnode->getNodeType == TEXT_NODE;
}

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

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

# 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);
    
    $type = $component_id_type{$id};
    $name = $component_id_name{$id};

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

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

sub print_debug {
    print STDERR $_[0] if ($debug);
}

sub usage {
    return 
	"\n" .
	"Usage: dia2abg.pl --diagram_name <diagram_name> [options]\n" .
	"Options:\n" .
	"\t--dia_input_file <dia_input_file>\n" .
	"\t--label_file <label_file>\n" .
	"\t--component_list_file\n" .
	"\t--create_component_list\n" .
	"\t--create_abg\n" .
	"\t--debug\n" .
	"\t--abg_file <abg_file>\n" .
	"\t--change_flow_causality <bond causality spec>\n" .
	"\t--change_effort_causality <bond causality spec>\n" .
	"\n" .
	"\t\tBond causality spec:\n" .
	"\t\t 'bond:causality;bond:causality;...'\n" .
	"\t\tbond:\n" .
	"\t\t [mtt_bond_id|all]\n" .







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<










<


|

|







534
535
536
537
538
539
540


















541
542
543
544
545
546
547
548
549
550

551
552
553
554
555
556
557
558
559
560
561
562
	$subnode->getNodeType == TEXT_NODE;
}

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



















sub print_debug {
    print STDERR $_[0] if ($debug);
}

sub usage {
    return 
	"\n" .
	"Usage: dia2abg.pl --diagram_name <diagram_name> [options]\n" .
	"Options:\n" .
	"\t--dia_input_file <dia_input_file>\n" .

	"\t--component_list_file\n" .
	"\t--create_component_list\n" .
	"\t--create_ibg\n" .
	"\t--debug\n" .
	"\t--ibg_file <ibg_file>\n" .
	"\t--change_flow_causality <bond causality spec>\n" .
	"\t--change_effort_causality <bond causality spec>\n" .
	"\n" .
	"\t\tBond causality spec:\n" .
	"\t\t 'bond:causality;bond:causality;...'\n" .
	"\t\tbond:\n" .
	"\t\t [mtt_bond_id|all]\n" .


MTT: Model Transformation Tools
GitHub | SourceHut | Sourceforge | Fossil RSS ]