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 )