App-Requirement-Arch
view release on metacpan or search on metacpan
scripts/ra_show_usecases.pl view on Meta::CPAN
{
warn "Skipping '$use_case->{ORIGIN_FILE}', name is empty string!\n" ;
next ;
}
if
(
exists $use_case->{ABSTRACTION_LEVEL}
&& $use_case->{ABSTRACTION_LEVEL} eq 'system'
)
{
warn "*** $use_case->{NAME} ***\n" ;
$body .= DumpTree
(
$use_case,
$use_case->{NAME},
RENDERER =>
{
NAME => 'DHTML',
COLLAPSED => $show_collapsed,
CLASS => "class_$use_case_number",
BUTTON =>
{
COLLAPSE_EXPAND => $show_collapse_button,
},
},
FILTER => \&use_case_filter,
FILTER_ARGUMENT =>
{
ALL_USE_CASES => \%use_cases,
LEVEL_0_FILTER =>
[
qw(
DESCRIPTION
ACTORS_INTERESTS
PRECONDITIONS
RELATED_REQUIREMENTS
STEPS
DEFINITION
)
],
},
NO_NO_ELEMENTS => 1,
DISPLAY_ADDRESS => 0,
DISPLAY_OBJECT_TYPE => 0,
) ;
$body .= '<br>' ;
}
}
$html_title = "Use cases" unless ($html_title);
my $header = '';
$header = read_file($header_file) if ($header_file);
print <<EOT;
<?xml version="1.0" encoding="iso-8859-1"?>
<!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"
>
<html>
<!-- Automatically generated by Perl and Data::TreeDumper::DHTML -->
<head>
<title>$html_title</title>
</head>
<body>
<p>$header</p>
$body
</body>
</html>
EOT
#------------------------------------------------------------------------------------------------------------------
sub ordered
{
use Tie::IxHash ;
tie my %hash, 'Tie::IxHash' => @_ ;
return \%hash ;
}
#------------------------------------------------------------------------------------------------------------------
sub use_case_filter
{
my ($tree, $level, $path, $nodes_to_display, $setup, $filter_argument) = @_ ;
if('use_case' eq ref $tree)
{
return('HASH', undef, grep {defined $tree->{$_}} @{$filter_argument->{LEVEL_0_FILTER}},) ;
}
else
{
if($path =~ /^\{'STEPS/)
{
#~ warn "$path\n" ;
if('HASH' eq ref $tree)
{
if($path =~ /\{'HANDLED_IN'\}$/)
{
for my $handler (keys %{$tree})
{
if(exists $filter_argument->{ALL_USE_CASES}{$handler})
{
warn "\tmerging '$handler'\n" ;
#~ warn "\t\t$_\n" for(split('\{', $path)) ;
use Storable qw(dclone);
$tree->{$handler}{DEFINITION} = dclone($filter_argument->{ALL_USE_CASES}{$handler}) ;
}
else
{
warn "\tCan't find sub use case '$handler'!\n" ;
}
}
( run in 0.488 second using v1.01-cache-2.11-cpan-39bf76dae61 )