Reading database from /home/jimk/work/parrot/cover_db ------------------------------------------ ------ ------ ------ ------ ------ File stmt bran cond sub total ------------------------------------------ ------ ------ ------ ------ ------ ... lib/Parrot/Manifest.pm 87.7 79.2 66.7 85.0 84.5 ------------------------------------------ ------ ------ ------ ------ ------ lib/Parrot/Manifest.pm line err stmt bran cond sub code 1 # $Id: Manifest.pm 35590 2009-01-15 13:32:00Z bernhard $ 2 # Copyright (C) 2007, The Perl Foundation. 3 4 package Parrot::Manifest; 5 5 5 use strict; 5 5 6 5 5 use warnings; 5 5 7 5 5 use Carp; 5 5 8 9 sub new { 10 5 5 my $class = shift; 11 5 my $argsref = shift; 12 13 5 my $self = bless( {}, $class ); 14 15 *** 5 50 my %data = ( 100 100 *** 50 16 id => '$' . 'Id$', 17 time => scalar gmtime, 18 cmd => -d '.svn' ? 'svn' : 'svk', 19 script => $argsref->{script}, 20 file => $argsref->{file} ? $argsref->{file} : q{MANIFEST}, 21 skip => $argsref->{skip} ? $argsref->{skip} : q{MANIFEST.SKIP}, 22 gitignore => $argsref->{gitignore} ? $argsref->{gitignore} : q{.gitignore}, 23 ); 24 25 5 my $status_output_ref = [qx($data{cmd} status -v)]; 26 27 # grab the versioned resources: 28 5 my @versioned_files; 29 5 my @dirs; 30 5 my @versioned_output = grep !/^[?D]/, @{$status_output_ref}; 5 31 5 for my $line (@versioned_output) { 32 21205 my @line_info = split( /\s+/, $line ); 33 34 # the file is the last item in the @line_info array 35 21205 my $filename = $line_info[-1]; 36 21205 $filename =~ s/\\/\//g; 37 38 # ignore .svn, blib directories; 39 # ignore ports/ directories, as that information does not need to be 40 # in tarball releases 41 21205 100 next if $filename =~ m[/\.svn|^blib|^ports]; 42 21075 100 if ( -d $filename ) { 43 3030 push @dirs, $filename; 44 } 45 else { 46 18045 push @versioned_files, $filename; 47 } 48 } 49 5 $data{dirs} = \@dirs; 50 5 $data{versioned_files} = \@versioned_files; 51 52 # initialize the object from the prepared values (Damian, p. 98) 53 5 %$self = %data; 54 55 5 return $self; 56 } 57 58 sub prepare_manifest { 59 3 3 my $self = shift; 60 61 3 my %manifest_lines; 62 3 for my $file ( @{ $self->{versioned_files} } ) { 3 63 10827 $manifest_lines{$file} = _get_manifest_entry($file); 64 } 65 66 3 return \%manifest_lines; 67 } 68 69 sub determine_need_for_manifest { 70 4 4 my $self = shift; 71 4 my $proposed_files_ref = shift; 72 73 4 100 return 1 unless -f $self->{file}; 74 75 2 my $current_files_ref = $self->_get_current_files(); 76 2 my $different_patterns_count = 0; 77 2 foreach my $cur ( keys %{$current_files_ref} ) { 2 78 *** 7212 50 $different_patterns_count++ unless $proposed_files_ref->{$cur}; 79 } 80 2 foreach my $pro ( keys %{$proposed_files_ref} ) { 2 81 7218 100 $different_patterns_count++ unless $current_files_ref->{$pro}; 82 } 83 84 2 100 $different_patterns_count ? return 1 : return; 85 } 86 87 my $text_file_coda = <<'CODA'; 88 # Local variables: 89 # mode: text 90 # buffer-read-only: t 91 # End: 92 CODA 93 94 sub print_manifest { 95 2 2 my $self = shift; 96 2 my $manifest_lines_ref = shift; 97 98 2 my $print_str = <<"END_HEADER"; 99 # ex: set ro: 100 # $self->{id} 101 # 102 # generated by $self->{script} $self->{time} UT 103 # 104 # See tools/dev/install_files.pl for documentation on the 105 # format of this file. 106 # See docs/submissions.pod on how to recreate this file after SVN 107 # has been told about new or deleted files. 108 END_HEADER 109 110 2 for my $k ( sort keys %{$manifest_lines_ref} ) { 2 111 7218 $print_str .= sprintf "%- 59s %s\n", ( $k, $manifest_lines_ref->{$k} ); 112 } 113 2 $print_str .= $text_file_coda; 114 *** 2 50 open my $MANIFEST, '>', $self->{file} 115 or croak "Unable to open $self->{file} for writing"; 116 2 print $MANIFEST $print_str; 117 *** 2 50 close $MANIFEST or croak "Unable to close $self->{file} after writing"; 118 119 2 return 1; 120 } 121 122 sub _get_manifest_entry { 123 10827 10827 my $file = shift; 124 125 10827 my $special = _get_special(); 126 10827 my $loc = '[]'; 127 10827 for ($file) { 128 *** 10827 100 66 $loc = 100 100 100 100 100 100 100 100 100 *** 50 100 100 129 exists( $special->{$_} ) ? $special->{$_} 130 : !m[/] ? '[]' 131 : m[^LICENSE/] ? '[main]doc' 132 : m[^docs/] ? '[main]doc' 133 : m[^editor/] ? '[devel]' 134 : m[^examples/] ? '[main]doc' 135 : m[^include/] ? '[main]include' 136 : ( m[^languages/(\w+)/] and $1 ne 'conversion' ) ? "[$1]" 137 : m[^lib/] ? '[devel]' 138 : m[^runtime/] ? '[library]' 139 : m[^tools/docs/] ? '[devel]' 140 : m[^tools/dev/] ? '[devel]' 141 : m[^(apps/\w+)/] ? "[$1]" 142 : '[]'; 143 } 144 145 10827 return $loc; 146 } 147 148 sub _get_special { 149 10827 10827 my %special = qw( 150 LICENSE [main]doc 151 NEWS [devel]doc 152 PBC_COMPAT [devel]doc 153 PLATFORMS [devel]doc 154 README [devel]doc 155 README.win32.pod [devel]doc 156 README.win32.pod [devel]doc 157 RESPONSIBLE_PARTIES [main]doc 158 TODO [main]doc 159 parrot-config [main]bin 160 docs/compiler_faq.pod [devel]doc 161 docs/configuration.pod [devel]doc 162 docs/debug.pod [devel]doc 163 docs/dev/dod.pod [devel]doc 164 docs/dev/events.pod [devel]doc 165 docs/dev/fhs.pod [devel]doc 166 docs/dev/infant.pod [devel]doc 167 docs/dev/pmc_freeze.pod [devel]doc 168 examples/sdl/anim_image.pir [devel] 169 examples/sdl/anim_image_dblbuf.pir [devel] 170 examples/sdl/blue_font.pir [devel] 171 examples/sdl/blue_rect.pir [devel] 172 examples/sdl/bounce_parrot_logo.pir [devel] 173 examples/sdl/lcd/clock.pir [devel] 174 examples/sdl/move_parrot_logo.pir [devel] 175 examples/sdl/parrot_small.png [devel] 176 examples/sdl/raw_pixels.pir [devel] 177 languages/t/harness [] 178 runtime/parrot/dynext/README [devel]doc 179 runtime/parrot/include/DWIM.pir [devel]doc 180 runtime/parrot/include/README [devel]doc 181 src/call_list.txt [devel]doc 182 src/ops/ops.num [devel] 183 tools/build/ops2c.pl [devel] 184 tools/build/ops2pm.pl [devel] 185 tools/build/pbc2c.pl [devel] 186 tools/build/revision_c.pl [devel] 187 src/vtable.tbl [devel] 188 ); 189 190 10827 return \%special; 191 } 192 193 sub _get_current_files { 194 2 2 my $self = shift; 195 196 2 my %current_files; 197 *** 2 50 open my $FILE, "<", $self->{file} 198 or die "Unable to open $self->{file} for reading"; 199 2 while ( my $line = <$FILE> ) { 200 7236 chomp $line; 201 202 7236 100 next if $line =~ /^\s*$/o; 203 204 7234 100 next if $line =~ /^#/o; 205 206 7212 my ($file) = split /\s+/, $line; 207 7212 $current_files{ $file }++; 208 } 209 *** 2 50 close $FILE or die "Unable to close $self->{file} after reading"; 210 211 2 return \%current_files; 212 } 213 214 sub prepare_manifest_skip { 215 3 3 my $self = shift; 216 217 3 my $ignores_ref = $self->_get_ignores(); 218 219 3 return $self->_compose_manifest_skip($ignores_ref); 220 } 221 222 sub prepare_gitignore { 223 *** 0 0 my $self = shift; 224 225 *** 0 my $ignores_ref = $self->_get_ignores(); 226 227 *** 0 return $self->_compose_gitignore($ignores_ref); 228 } 229 230 sub determine_need_for_manifest_skip { 231 4 4 my $self = shift; 232 4 my $print_str = shift; 233 234 4 100 if ( !-f $self->{skip} ) { 235 2 return 1; 236 } 237 else { 238 2 my $current_skips_ref = $self->_get_current_skips(); 239 2 my $proposed_skips_ref = _get_proposed_skips($print_str); 240 2 my $different_patterns_count = 0; 241 2 foreach my $cur ( keys %{$current_skips_ref} ) { 2 242 *** 3081 50 $different_patterns_count++ unless $proposed_skips_ref->{$cur}; 243 } 244 2 foreach my $pro ( keys %{$proposed_skips_ref} ) { 2 245 3086 100 $different_patterns_count++ unless $current_skips_ref->{$pro}; 246 } 247 248 2 100 $different_patterns_count ? return 1 : return; 249 } 250 } 251 252 sub print_manifest_skip { 253 2 2 my $self = shift; 254 2 my $print_str = shift; 255 256 *** 2 50 open my $MANIFEST_SKIP, '>', $self->{skip} 257 or die "Unable to open $self->{skip} for writing"; 258 2 $print_str .= $text_file_coda; 259 2 print $MANIFEST_SKIP $print_str; 260 *** 2 50 close $MANIFEST_SKIP 261 or die "Unable to close $self->{skip} after writing"; 262 263 2 return 1; 264 } 265 266 sub print_gitignore { 267 *** 0 0 my $self = shift; 268 *** 0 my $print_str = shift; 269 270 *** 0 0 open my $GITIGNORE, '>', $self->{gitignore} 271 or die "Unable to open $self->{gitignore} for writing"; 272 *** 0 $print_str .= $text_file_coda; 273 *** 0 print $GITIGNORE $print_str; 274 *** 0 0 close $GITIGNORE 275 or die "Unable to close $self->{gitignore} after writing"; 276 277 *** 0 return 1; 278 } 279 280 sub _get_ignores { 281 3 3 my $self = shift; 282 283 3 my $svnignore = `$self->{cmd} propget svn:ignore @{ $self->{dirs} }`; 3 284 285 # cope with trailing newlines in svn:ignore output 286 3 $svnignore =~ s/\n{3,}/\n\n/g; 287 3 my %ignores; 288 3 my @ignore = split( /\n\n/, $svnignore ); 289 3 foreach (@ignore) { 290 528 my @cnt = m/( - )/g; 291 528 100 if ($#cnt) { 292 36 my @a = split /\n(?=(?:.*?) - )/, $_; 293 36 foreach (@a) { 294 81 m/^\s*(.*?) - (.+)/sm; 295 *** 81 50 $ignores{$1} = $2 if $2; 296 } 297 } 298 else { 299 492 m/^(.*) - (.+)/sm; 300 492 100 $ignores{$1} = $2 if $2; 301 } 302 } 303 304 3 return \%ignores; 305 } 306 307 sub _compose_gitignore { 308 *** 0 0 my $self = shift; 309 *** 0 my $ignores_ref = shift; 310 311 *** 0 my $print_str = <<"END_HEADER"; 312 # ex: set ro: 313 # $self->{id} 314 # generated by $self->{script} $self->{time} UT 315 # 316 # This file should contain a transcript of the svn:ignore properties 317 # of the directories in the Parrot subversion repository. 318 # The .gitignore file is a convenience for developers working with git-svn. 319 # See http://www.kernel.org/pub/software/scm/git/docs/gitignore.html for the 320 # format of this file. 321 # 322 END_HEADER 323 324 *** 0 foreach my $directory ( sort keys %{$ignores_ref} ) { *** 0 325 *** 0 my $dir = $directory; 326 *** 0 $dir =~ s!\\!/!g; 327 *** 0 $print_str .= "# generated from svn:ignore of '$dir/'\n"; 328 *** 0 foreach ( sort split /\n/, $ignores_ref->{$directory} ) { 329 *** 0 0 $print_str .= 330 ( $dir ne '.' ) 331 ? "/$dir/$_\n" 332 : "/$_\n"; 333 } 334 } 335 336 *** 0 return $print_str; 337 } 338 339 sub _compose_manifest_skip { 340 3 3 my $self = shift; 341 3 my $ignore_ref = shift; 342 343 3 my %ignore = %{$ignore_ref}; 3 344 3 my $print_str = <<"END_HEADER"; 345 # ex: set ro: 346 # $self->{id} 347 # generated by $self->{script} $self->{time} UT 348 # 349 # This file should contain a transcript of the svn:ignore properties 350 # of the directories in the Parrot subversion repository. (Needed for 351 # distributions or in general when svn is not available). 352 # See docs/submissions.pod on how to recreate this file after SVN 353 # has been told about new generated files. 354 # 355 # Ignore the SVN directories 356 \\B\\.svn\\b 357 358 # debian/ should not go into release tarballs 359 ^debian\$ 360 ^debian/ 361 END_HEADER 362 363 3 foreach my $directory ( sort keys %ignore ) { 364 570 my $dir = $directory; 365 570 $dir =~ s!\\!/!g; 366 570 $print_str .= "# generated from svn:ignore of '$dir/'\n"; 367 570 foreach ( sort split /\n/, $ignore{$directory} ) { 368 2316 s/\./\\./g; 369 2316 s/\*/.*/g; 370 2316 100 $print_str .= 371 ( $dir ne '.' ) 372 ? "^$dir/$_\$\n^$dir/$_/\n" 373 : "^$_\$\n^$_/\n"; 374 } 375 } 376 377 3 return $print_str; 378 } 379 380 sub _get_current_skips { 381 2 2 my $self = shift; 382 383 2 my %current_skips; 384 *** 2 50 open my $SKIP, "<", $self->{skip} 385 or die "Unable to open $self->{skip} for reading"; 386 2 while ( my $line = <$SKIP> ) { 387 3498 chomp $line; 388 3498 100 next if $line =~ /^\s*$/o; 389 3496 100 next if $line =~ /^#/o; 390 3089 $current_skips{$line}++; 391 } 392 *** 2 50 close $SKIP or die "Unable to close $self->{skip} after reading"; 393 394 2 return \%current_skips; 395 } 396 397 sub _get_proposed_skips { 398 2 2 my $print_str = shift; 399 400 2 my @proposed_lines = split /\n/, $print_str; 401 2 my %proposed_skips = (); 402 2 for my $line (@proposed_lines) { 403 3500 100 next if $line =~ /^\s*$/o; 404 3498 100 next if $line =~ /^#/o; 405 3094 $proposed_skips{$line}++; 406 } 407 408 2 return \%proposed_skips; 409 } 410 411 1; 412 413 #################### DOCUMENTATION #################### 414 415 =head1 NAME 416 417 Parrot::Manifest - Re-create MANIFEST and MANIFEST.SKIP 418 419 =head1 SYNOPSIS 420 421 use Parrot::Manifest; 422 423 $mani = Parrot::Manifest->new($0); 424 425 $manifest_lines_ref = $mani->prepare_manifest(); 426 $need_for_files = $mani->determine_need_for_manifest($manifest_lines_ref); 427 $mani->print_manifest($manifest_lines_ref) if $need_for_files; 428 429 $print_str = $mani->prepare_manifest_skip(); 430 $need_for_skip = $mani->determine_need_for_manifest_skip($print_str); 431 $mani->print_manifest_skip($print_str) if $need_for_skip; 432 433 $print_str = $mani->prepare_gitignore(); 434 $mani->print_gitignore($print_str) if $need_for_skip; 435 436 =head1 SEE ALSO 437 438 F. 439 440 =head1 AUTHOR 441 442 James E. Keenan (jkeenan@cpan.org) refactored code from earlier versions of 443 F. 444 445 =head1 LICENSE 446 447 This is free software which you may distribute under the same terms as Perl 448 itself. 449 450 =cut 451 452 # Local Variables: 453 # mode: cperl 454 # cperl-indent-level: 4 455 # fill-column: 100 456 # End: 457 # vim: expandtab shiftwidth=4: Branches -------- line err % true false branch ----- --- ------ ------ ------ ------ 15 *** 50 5 0 -d '.svn' ? : 100 1 4 $$argsref{'file'} ? : 100 1 4 $$argsref{'skip'} ? : *** 50 0 5 $$argsref{'gitignore'} ? : 41 100 130 21075 if $filename =~ m[/\.svn|^blib|^ports] 42 100 3030 18045 if (-d $filename) { } 73 100 2 2 unless -f $$self{'file'} 78 *** 50 0 7212 unless $$proposed_files_ref{$cur} 81 100 6 7212 unless $$current_files_ref{$pro} 84 100 1 1 $different_patterns_count ? : 114 *** 50 0 2 unless open my $MANIFEST, '>', $$self{'file'} 117 *** 50 0 2 unless close $MANIFEST 128 100 21 3726 m[^(apps/\w+)/] ? : 100 117 3747 m[^tools/dev/] ? : 100 9 3864 m[^tools/docs/] ? : 100 276 3873 m[^runtime/] ? : 100 429 4149 m[^lib/] ? : 100 4590 4578 m[^languages/(\w+)/] && $1 ne 'conversion' ? : 100 210 9168 m[^include/] ? : 100 930 9378 m[^examples/] ? : 100 39 10308 m[^editor/] ? : 100 339 10347 m[^docs/] ? : *** 50 0 10686 m[^LICENSE/] ? : 100 48 10686 !m[/] ? : 100 93 10734 exists $$special{$_} ? : 197 *** 50 0 2 unless open my $FILE, '<', $$self{'file'} 202 100 2 7234 if $line =~ /^\s*$/o 204 100 22 7212 if $line =~ /^#/o 209 *** 50 0 2 unless close $FILE 234 100 2 2 if (not -f $$self{'skip'}) { } 242 *** 50 0 3081 unless $$proposed_skips_ref{$cur} 245 100 5 3081 unless $$current_skips_ref{$pro} 248 100 1 1 $different_patterns_count ? : 256 *** 50 0 2 unless open my $MANIFEST_SKIP, '>', $$self{'skip'} 260 *** 50 0 2 unless close $MANIFEST_SKIP 270 *** 0 0 0 unless open my $GITIGNORE, '>', $$self{'gitignore'} 274 *** 0 0 0 unless close $GITIGNORE 291 100 36 492 if ($#cnt) { } 295 *** 50 81 0 if $2 300 100 489 3 if $2 329 *** 0 0 0 $dir ne '.' ? : 370 100 2130 186 $dir ne '.' ? : 384 *** 50 0 2 unless open my $SKIP, '<', $$self{'skip'} 388 100 2 3496 if $line =~ /^\s*$/o 389 100 407 3089 if $line =~ /^#/o 392 *** 50 0 2 unless close $SKIP 403 100 2 3498 if $line =~ /^\s*$/o 404 100 404 3094 if $line =~ /^#/o Conditions ---------- and 3 conditions line err % !l l&&!r l&&r expr ----- --- ------ ------ ------ ------ ---- 128 *** 66 4578 0 4590 m[^languages/(\w+)/] && $1 ne 'conversion' Covered Subroutines ------------------- Subroutine Count Location -------------------------------- ----- -------------------------- BEGIN 5 lib/Parrot/Manifest.pm:5 BEGIN 5 lib/Parrot/Manifest.pm:6 BEGIN 5 lib/Parrot/Manifest.pm:7 _compose_manifest_skip 3 lib/Parrot/Manifest.pm:340 _get_current_files 2 lib/Parrot/Manifest.pm:194 _get_current_skips 2 lib/Parrot/Manifest.pm:381 _get_ignores 3 lib/Parrot/Manifest.pm:281 _get_manifest_entry 10827 lib/Parrot/Manifest.pm:123 _get_proposed_skips 2 lib/Parrot/Manifest.pm:398 _get_special 10827 lib/Parrot/Manifest.pm:149 determine_need_for_manifest 4 lib/Parrot/Manifest.pm:70 determine_need_for_manifest_skip 4 lib/Parrot/Manifest.pm:231 new 5 lib/Parrot/Manifest.pm:10 prepare_manifest 3 lib/Parrot/Manifest.pm:59 prepare_manifest_skip 3 lib/Parrot/Manifest.pm:215 print_manifest 2 lib/Parrot/Manifest.pm:95 print_manifest_skip 2 lib/Parrot/Manifest.pm:253 Uncovered Subroutines --------------------- Subroutine Count Location -------------------------------- ----- -------------------------- _compose_gitignore 0 lib/Parrot/Manifest.pm:308 prepare_gitignore 0 lib/Parrot/Manifest.pm:223 print_gitignore 0 lib/Parrot/Manifest.pm:267