view release on metacpan or  search on metacpan

bin/dtddiff  view on Meta::CPAN

      my $elem_info1 = $dtd1->{'elements'}{$gi};
      my $elem_info2 = $dtd2->{'elements'}{$gi};
      if ($opts{'elements'}) {
        my $model_type = $opts{'content-model-expanded'}
                         ? 'content-model-expanded-tree'
                         : 'content-model-tree';
        my $cmp_model1 = 
              sort_content_model_tree($elem_info1->{$model_type});
           $cmp_model1 .=
              sort_content_model_tree($elem_info1->{'inclusion-tree'})
                  if $elem_info1->{'inclusion-tree'};
           $cmp_model1 .=
              sort_content_model_tree($elem_info1->{'exclusion-tree'})
                  if $elem_info1->{'exclusion-tree'};
        my $cmp_model2 = 
              sort_content_model_tree($elem_info2->{$model_type});
           $cmp_model2 .=
              sort_content_model_tree($elem_info2->{'inclusion-tree'})
                  if $elem_info2->{'inclusion-tree'};
           $cmp_model2 .=
              sort_content_model_tree($elem_info2->{'exclusion-tree'})
                  if $elem_info1->{'exclusion-tree'};

        # content models differ
        if ($cmp_model1 ne $cmp_model2) {
          $elem_diff_rec->{'name'}  = $gi;
          $elem_diff_rec->{'model'} = 1;
        }
      }

      # check attributes
      if ($opts{'attributes'}) {
	my $attrs1 = $elem_info1->{'attributes'} || +{ };
	my $attrs2 = $elem_info2->{'attributes'} || +{ };
	my $attrs_added      = [ ];
	my $attrs_subtracted = [ ];
	my $attrs_diff       = [ ];

	# attributes subtracted
	foreach $aname (sort keys %$attrs1) {
	  if (!defined($attrs2->{$aname})) {
	    push(@$attrs_subtracted, $aname);
	  }
	}
	# attributes added and changed
	foreach $aname (sort keys %$attrs2) {
	  if (!defined($attrs1->{$aname})) {
	    push(@$attrs_added, $aname);
	    next;
	  }
	  my $attr_info1  = $attrs1->{$aname};
	  my $attr_info2  = $attrs2->{$aname};
	  my $attr_value1 = $attr_info1->{'value'};
	  my $attr_value2 = $attr_info2->{'value'};
	  my $attr_def1   = $attr_info1->{'default'};
	  my $attr_def2   = $attr_info2->{'default'};
	  my $attr_type1  = $attr_info1->{'type'};
	  my $attr_type2  = $attr_info2->{'type'};

	  $attr_def1 = lc $attr_def1  if $dtd1->{'namecase-general'} &&
					 $attr_type1 !~ /^cdata$/i;
	  $attr_def2 = lc $attr_def2  if $dtd2->{'namecase-general'} &&
					 $attr_type2 !~ /^cdata$/i;

	  $attr_value1 = lc $attr_value1  if $dtd1->{'namecase-general'};
	  $attr_value2 = lc $attr_value2  if $dtd2->{'namecase-general'};

	  if ($attr_type1  ne $attr_type2  ||
	      $attr_value1 ne $attr_value2 ||
	      $attr_def1   ne $attr_def2   ||
	      $attr_info1->{'enumeration'} ne $attr_info2->{'enumeration'}) {
	    push(@$attrs_diff, $aname);
	  }
	}

	if (scalar(@$attrs_added)) {
	  $elem_diff_rec->{'name'}  = $gi;
	  $elem_diff_rec->{'attr_added'} = $attrs_added;
	}
	if (scalar(@$attrs_subtracted)) {
	  $elem_diff_rec->{'name'}  = $gi;
	  $elem_diff_rec->{'attr_subtracted'} = $attrs_subtracted;
	}
	if (scalar(@$attrs_diff)) {
	  $elem_diff_rec->{'name'}  = $gi;
	  $elem_diff_rec->{'attr_diff'} = $attrs_diff;
	}
      }

      push(@elems_diff, $elem_diff_rec)  if scalar(%$elem_diff_rec);
    }
  }

  # Print diff
  print $outfh "*** $title1\n";
  print $outfh "--- $title2\n";

  if ($opts{'param-ents'}) {
    if (@param_subtracted) {
      print $outfh ('*' x 15), " Parameter Entities Subtracted\n";
      print $outfh "*** $title1 ****\n";
      foreach $gi (@param_subtracted) {
	print $outfh '- ', $gi, "\n";
      }
    }
    if (@param_added) {
      print $outfh ('*' x 15), " Parameter Entities Added\n";
      print $outfh "--- $title2 ----\n";
      foreach $gi (@param_added) {
	print $outfh '+ ', $gi, "\n";
      }
    }
    if (@param_diff) {
      print $outfh ('*' x 15), " Parameter Entities Changed\n";
      foreach $gi (@param_diff) {
	print $outfh "*** $title1 ****\n\n";
	print $outfh '! %', $gi, "; = \n";
	local $param_value = $dtd1->{'entities'}{'param'}{$gi}{'text-expanded'};
	select((select($outfh),
		$~ = "PARAM_DIFF_CHNG",
		$= = 10000000,
		$: = "|&, \t\n"
	       )[0]);

bin/dtddiff  view on Meta::CPAN

	if ($gi eq 'exclusions') {
	  last SW  unless defined $cur_dtd_elem;
	  $dtd->{'elements'}{$cur_dtd_elem}{'exclusions'} = '';
	  $cur_model = \$dtd->{'elements'}{$cur_dtd_elem}{'exclusions'};
	  $tree_node = 
	      $dtd->{'elements'}{$cur_dtd_elem}{'exclusion-tree'} = [ ];
	  last SW;
	}

	if ($gi eq 'sequence-group' ||
	    $gi eq 'or-group' ||
	    $gi eq 'and-group') {
	  last SW  if !defined($cur_dtd_elem) || !defined($cur_model);
	  if (scalar(@first_in_group)) {
	    $$cur_model .= $model_group
		if (!$first_in_group[$#first_in_group]);
	    $first_in_group[$#first_in_group] = 0;
	  }
	  $$cur_model .= '(';

	  $group_occurrence = $attr{'occurrence'} || "";
	  push(@group_occurrence, $group_occurrence);

	  $model_group =   $gi eq 'sequence-group' ? ','
			 : $gi eq 'or-group'       ? '|'
			 :                           '&';
	  push(@model_group, $model_group);
	  push(@first_in_group, 1);

	  my $new_node = [ $model_group, $group_occurrence ];
	  push(@$tree_node, $new_node);
	  push(@node_stack, $tree_node);
	  $tree_node = $new_node;

	  last SW;
	}

	if ($gi eq 'element-name') {
	  last SW  if !defined($cur_dtd_elem) || !defined($cur_model);
	  $elem_name = $attr{'name'};
	  $occurrence = $attr{'occurrence'} || '';
	  $elem_name = lc($elem_name)  if ($dtd->{'namecase-general'});
	  $$cur_model .= $model_group  if (!$first_in_group[$#first_in_group]);
	  $$cur_model .= $elem_name . $occurrence;
	  $first_in_group[$#first_in_group] = 0;

	  push(@$tree_node, $elem_name.$occurrence);
	  last SW;
	}

	if ($gi eq 'parament-name') {
	  last SW  if !defined($cur_dtd_elem) || !defined($cur_model);
	  $$cur_model .= $model_group  if (!$first_in_group[$#first_in_group]);
	  $$cur_model .= '%'.$attr{'name'}.';';
	  $first_in_group[$#first_in_group] = 0;

	  push(@$tree_node, '%'.$attr{'name'}.';');
	  last SW;
	}

	if ($gi eq 'pcdata') {
	  last SW  if !defined($cur_dtd_elem) || !defined($cur_model);
	  $$cur_model .= $model_group  if (!$first_in_group[$#first_in_group]);
	  $$cur_model .= '#PCDATA';
	  $first_in_group[$#first_in_group] = 0;

	  push(@$tree_node, '#PCDATA');
	  last SW;
	}

	if ($gi eq 'rcdata') {
	  last SW  if !defined($cur_dtd_elem) || !defined($cur_model);
	  $$cur_model .= 'RCDATA';

	  push(@$tree_node, 'RCDATA');
	  last SW;
	}

	if ($gi eq 'cdata') {
	  last SW  if !defined($cur_dtd_elem) || !defined($cur_model);
	  $$cur_model .= 'CDATA';
	  push(@$tree_node, 'CDATA');
	  last SW;
	}

	if ($gi eq 'empty') {
	  last SW  if !defined($cur_dtd_elem) || !defined($cur_model);
	  $$cur_model .= 'EMPTY';
	  push(@$tree_node, 'EMPTY');
	  last SW;
	}


	if ($gi eq 'attlist') {
	  $cur_dtd_elem = $attr{'name'};
	  $cur_dtd_elem = lc($cur_dtd_elem)  if ($dtd->{'namecase-general'});
	  $dtd->{'elements'}{$cur_dtd_elem}{'attributes'} = { };
	  last SW;
	}

	if ($gi eq 'attribute') {
	  last SW  unless defined($cur_dtd_elem);
	  my $attr_name = $attr{'name'};
	  $attr_name = lc($attr_name)  if ($dtd->{'namecase-general'});
	  $dtd->{'elements'}{$cur_dtd_elem}{'attributes'}{$attr_name} = {
	    type => $attr{'type'},
	    value => $attr{'value'},
	    default => $attr{'default'},
	    enumeration => ($attr{'enumeration'} || 'no'),
	  };
	  last SW;
	}

      } # End: SW
    }, # End: Start Handler

    ## End tag handler ------------------------------------------------------
    End =>
    sub {
      my $expact = shift;
      my $gi     = shift;

      my $name = pop(@element_stack);
      SW: {
	if ($gi eq 'entity') {
	  $cur_entity->{'text-expanded'} =~ s/\s+/ /g;
	  $cur_entity->{'text'}          =~ s/\s+/ /g;
	  $cur_entity = undef;
	  last SW;
	}

	if ($gi eq 'element' ||
	    $gi eq 'attlist') {
	  $cur_dtd_elem = undef;
	  $cur_model = undef;
	  last SW;
	}

	if ($gi eq 'content-model-expanded' ||