view release on metacpan or  search on metacpan

PMVersionInfo.pm  view on Meta::CPAN

	warn "$version in $path\n" if $CHAT and defined $version;
	return $version;
}

=head2 METHOD get_from_MANIFEST

As the C<get> method, but only gets information from files listed
in a C<MANIFEST> file, the path to which should be passed as the first argument.

Additionally, the name of a C<MANIFEST.SKIP> file may be passed as a further argument,
in which case no information will be garthered from files listed therein.

=cut

sub get_from_MANIFEST { my ($self,$manifest,$manifest_skip) = (@_);
	croak "No manifest file passed as argument" if not defined $manifest;
	croak "No such manifest file as $manifest" if not -e $manifest;
	local *IN;
	my %skip;
	if (defined $manifest_skip){
		croak "No such MANIFEST.SKIP file as $manifest_skip" if not -e $manifest_skip;
		open IN, $manifest_skip;
		while (<IN>){
			chomp;
			$skip{$_} = 1;
		}
		close IN;
	}
	open MANIFEST,$manifest or croak "Could not open $manifest";
	while (<IN>){
		chomp;
		next if exists $skip{$_};
		push @{$self->{tree}}, {
			path => $_,
			version => &version_from($_)
		};
	}
	close IN;
	return 1;
}

=head2 METHOD store

Accepts an object-reference and optionally a registry path to act as a root at which to secure
the C<$VERSION> info from every file in the object's C<tree> slot.  If no 'root' is supplied,
the calling object's C<reg_root> slot is used. Incidentally returns the root used after making
changes to the registry.

=cut

sub store { my ($self,$root) = (shift,shift);
	$root = $self->{reg_root} if not defined $root;
	foreach my $file (sort @{$self->{tree}}){
		if (exists $file->{version} and $file->{version} ne ''){
			# warn $file->{path},"\t",$file->{version},"\n";
			$file->{path} =~ s/^\Q$self->{strip_path}\E//i;
			$file->{path} =~ s/\.[^.]*$// if defined  $self->{extension};
			$file->{path} =~ s|\\|/|g;
			# Build the heirachy
			my $path = $root;
			foreach my $part (split m|/|,$file->{path}){
				$path .= $part.'/';
				$_ = $Registry->{ $path };
				$Registry->{ $path } = {} if not defined $_;
			}
			# Make the keys from all the values in %{$file}, except $path
			foreach (keys %{$file}){
				next if $_ eq 'path';
				$Registry->{ $root.$file->{path} } = {$_ => $file->{$_} };
			}
		} else {
			warn "No version in file '$file->{path}'\n" if $CHAT;
		}
	}
	return $root;
}




1;	# Moduel must return a true value

__END__

=head1 CAVEATS

=over4

=item *

Be sure to pass all directories with a trailing '/'.

=item *

On Win32, it seems the C<sub get> has problems with the C<-d> operator detecting
whether a file is not a directory.

=back

=head1 SEE ALSO

L<ExtUtils::MakeMaker>, L<Win32::TieRegistry>.

=head1 KEYWORDS

Windows registry, perl module, version information, versions,
recursion .

=head1 AUTHOR

Lee Goddard <lgoddard@cpan.org>

=head1 COPYRIGHT

Copyright 2001, Lee Goddard.  All rights reserved.

Available for public use under the same terms as Perl itself.
This was developed as part of a private project, and is made
available without promise of adding anything useful to it.