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