view release on metacpan or  search on metacpan

lib/Data/Edit/Xml/Lint.pm  view on Meta::CPAN

       }
     }
   }

  @multipleLabelDefs
 } # multipleLabelDefs

sub multipleLabelDefsReport($)                                                  #S Return a L<report|/report> showing L<labels and id|Data::Edit::Xml/Labels> with multiple definitions in each L<project|/project> ordered by most defined
 {my ($labelDefs) = @_;                                                         # Label and Id definitions

  if (my @m = Data::Edit::Xml::Lint::multipleLabelDefs                          # Find multiple label or id definitions
                                           ($labelDefs))
   {$_->[2] = scalar(@{$_->[2]}) for @m;                                        # Replace array of multiple definitions with count thereof
    my $m = @m;
    return "MultipleLabelOrIdDefinitions ($m):\n".formatTable                   # Zero multiple label or id definitions
     ([[qw(Project Label Count)],
        sort {$b->[2] <=> $a->[2]} @m                                           # Sort so that the most frequent are first
     ]);
   }
  'No MultipleLabelOrIdDefinitions'                                             # Zero multiple label or id definitions
 } # multipleLabelDefsReport

sub singleLabelDefs($)                                                          #S Return ([L<project|/project>; label or id]*) of all labels or ids that have a single definition
 {my ($labelDefs) = @_;                                                         # Label and Id definitions
  $labelDefs and ref($labelDefs) =~ /hash/is or                                 # Check definitions have been provided
    confess "No labelDefs provided";
  my @singleLabelDefs;                                                          # Labels or ids with just one definition
  for my $project(sort keys % $labelDefs)                                       # Sub(linkmap = {L<project/>}{L<label or id|Data::Edit::Xml/Labels>}=[</file>; id]) returns true if the processing of each L<file|/file> is to be performed after the link...
   {for my $label(sort keys %{$labelDefs->{$project}})                          # Each source label or id
     {if (my $l = $labelDefs->{$project}{$label})                               # Source label or id
       {push @singleLabelDefs, [$project, $label] if @$l == 1;                  # Ids or labels with just one definition
       }
     }
   }

  @singleLabelDefs
 } # singleLabelDefs

sub singleLabelDefsReport($)                                                    #S Return a L<report|/report> showing L<label or id|Data::Edit::Xml/Labels> with just one definitions ordered by L<project|/project>, L<label name|Data::Edit::Xml/Labels>
 {my ($labelDefs) = @_;                                                         # Label and Id definitions

  if (my @s = Data::Edit::Xml::Lint::singleLabelDefs                            # Find single label or id definitions
                                         ($labelDefs))
   {my $s = @s;
    return "SingleLabelOrIdDefinitions ($s):\n".formatTable
     ([[qw(Project Label)],
        sort                                                                    # Sort by project and label
         {my $p = $a->[0] cmp $b->[0];
          my $l = $a->[1] cmp $b->[1];
          return $p if $p;
          $l
         } @s
     ]);
   }
  'No SingleLabelOrIdDefinitions'                                               # Zero multiple label or id definitions
 } # singleOrIdDefinitionsReport


#D1 Report                                                                      # Methods for L<reporting|Data::Edit::Xml::Lint/report> the results of L<linting|/lint> several L<files|/file>

sub p4($$)                                                                      #PS Format a fraction as a percentage to 4 decimal places
 {my ($p, $f) = @_;                                                             # Pass, fail
  my $n = $p + $f;
  return 0 if $n == 0;
  $n > 0 or confess "Division by zero";
  my $r = sprintf("%3.4f", 100 * $p / $n);
  $r =~ s/\.0+\Z//gsr                                                           # Remove trailing zeroes
 }

sub report($;$)                                                                 #S Analyze the results of prior L<lints|/lint> and return a hash reporting various statistics and a L<printable|/print> report
 {my ($outputDirectory, $filter) = @_;                                          # Directory to search, optional regular expression to filter files

  my @x;                                                                        # Lints for all L<files|/file>
  for my $in(findFiles($outputDirectory))                                       # Find files to report on
   {next if $filter and $in !~ m($filter);                                      # Filter files if a filter has been supplied
    push @x, Data::Edit::Xml::Lint::read($in);                                  # Reload a previously written L<file|/file>
   }

  lll "No files selected" unless @x;                                            # No files selected
  return undef unless @x;

  my %projects;                                                                 # Pass/Fail by project
  my %files;                                                                    # Pass fail by file
  my %filesToProjects;                                                          # Project from file name
  my $totalErrors = 0;                                                          # Total number of errors
  my $totalCompressedErrorsFileByFile = 0;                                      # Total number of errors summed file by file
  my %examples;                                                                 # Compressed errors example files
  my %docTypes;                                                                 # Document types

  for my $x(@x)                                                                 # Aggregate the results of individual lints
   {my $file    = $x->file;
    next unless $file;                                                          # Not in the expected format
    my $project = $x->project // 'unknown';
    my $cErrors = $x->compressedErrors;                                         # Compressed errors
    my $errors  = $x->errors;                                                   # Number of uncompressed errors
    my $cet     = $x->compressedErrorText;                                      # Compressed errors
    my $et      = $x->errorText;                                                # Uncompressed error text
    $filesToProjects{$file} = $project;
    my $pf = $errors ? qq(fail) : qq(pass);
    $projects{$project}{$pf}++;
    $files{$file}                     = $cErrors;
    $totalErrors                     += $errors;
    $totalCompressedErrorsFileByFile += $cErrors;

    if ($cet)                                                                   # Compressed errors over all files
     {for my $message(@$cet)
       {$message =~ s(\A<!--)  ()gs;                                            # Remove xml comments
        $message =~ s(-->\Z)   ()gs;
        $message =~ s(\s*\x29) (\x29)gs;
        $message = deduplicateSequentialWordsInString($message);                # Remove duplicate sequential words in message

        my $m = firstNChars $message, maxLintMsgLength;                         # Limit the length of messages to make the report more readable and collect similar errors together.
        $examples{$m}{$file}++                                                  # Files that exhibit this message
       }
     }
    if (my $d = $x->docType)                                                    # Document type summary
     {$docTypes{(split /\s+/, $d)[1]//$d}++;
     }
   }

  my @passingProjects;