File Coverage

blib/lib/PAR/Repository.pm

Criterion	Covered	Total	%
statement	40	42	95.2
branch			n/a
condition			n/a
subroutine	14	14	100.0
pod			n/a
total	54	56	96.4

line	stmt	sub	time	code
1				package PAR::Repository;
2
3	7	7	175055	use 5.006;
	7		30
	7		270
4	7	7	36	use strict;
	7		14
	7		237
5	7	7	30	use warnings;
	7		18
	7		252
6
7	7	7	35	use Carp qw/croak/;
	7		14
	7		556
8	7	7	12648	use File::Spec::Functions qw/catfile catdir splitpath/;
	7		6139
	7		534
9	7	7	41	use File::Path qw/mkpath/;
	7		14
	7		427
10	7	7	6846	use PAR::Dist qw//;
	7		56098
	7		194
11	7	7	6193	use YAML::Syck qw//;
	7		15709
	7		146
12	7	7	6615	use File::Copy qw//;
	7		41146
	7		211
13	7	7	131	use Cwd qw//;
	7		13
	7		114
14	7	7	7599	use Archive::Zip qw//;
	7		614024
	7		186
15	7	7	72	use File::Temp qw//;
	7		12
	7		111
16	7	7	5581	use version qw//;
	7		14713
	7		183
17	7	7	12317	use PAR::Indexer qw//;
	0
	0
18
19				use PAR::Repository::Zip;
20				use PAR::Repository::DBM;
21				use PAR::Repository::Query;
22				our @ISA = qw(
23				PAR::Repository::Zip
24				PAR::Repository::DBM
25				PAR::Repository::Query
26				);
27
28				use constant REPOSITORY_INFO_FILE => 'repository_info.yml';
29
30				our $VERSION = '0.21';
31				our $VERBOSE = 0;
32
33				# does the running platform have symlinks?
34				our $Supports_Symlinks =
35				exists($ENV{PAR_REPOSITORY_SYMLINK_SUPPORT})
36				? $ENV{PAR_REPOSITORY_SYMLINK_SUPPORT}
37				: eval { symlink("",""); 1 };
38
39				# template for a repository_info.yml file
40				our $Info_Template = {
41				repository_version => $VERSION,
42				# on platforms which don't have symlinks, fake them for new repositories!
43				($Supports_Symlinks ? () : (fake_symlinks => 1)),
44				};
45
46				# Hash of compatible PAR::Repository versions
47				our $Compatible_Versions = {
48				$VERSION => 1,
49				'0.19'=> 1,
50				'0.18_01'=> 1,
51				'0.17_01'=> 1,
52				'0.17'=> 1,
53				'0.16_02' => 1,
54				'0.16_01' => 1,
55				'0.16' => 1,
56				'0.15' => 1,
57				'0.14' => 1,
58				'0.13' => 1,
59				'0.12' => 1,
60				'0.11' => 1,
61				'0.10' => 1,
62				'0.03' => 1,
63				'0.02' => 1,
64				};
65
66				=head1 NAME
67
68				PAR::Repository - Create and modify PAR repositories
69
70				=head1 SYNOPSIS
71
72				# Usually, you want to use the 'parrepo' script which comes with
73				# this distribution.
74				use PAR::Repository;
75
76				my $repo = PAR::Repository->new( path => '/path/to/repository' );
77				# creates a new repository if it doesn't exist, opens it if it
78				# does exist.
79
80				$repo->inject(
81				file => 'Foo-Bar-0.01-x86_64-linux-gnu-thread-multi-5.8.7.par'
82				);
83				$repo->remove(
84				file => '...'
85				);
86				$repo->query_module(regex => 'Foo::Bar');
87
88				=head1 DESCRIPTION
89
90				This module is intended for creation and maintenance of PAR repositories.
91				A PAR repository is collection of F<.par> archives which contain Perl code
92				and associated libraries for use on specific platforms. In the most common
93				case, these archives differ from CPAN distributions in that they ship the
94				(possibly compiled) output of C in the F subdirectory of the
95				CPAN distribution's build directory.
96
97				You can access a PAR repository using the L module
98				or the L module which provides syntactic sugar around the client.
99				L allows you to load libraries from repositories on demand.
100
101				=head2 PAR REPOSITORIES
102
103				A PAR repository is, basically, just a directory with certain stuff in it.
104				It contains:
105
106				=over 2
107
108				=item modules_dists.dbm.zip
109
110				An index that maps module names to file names.
111				Details can be found in L.
112
113				=item symlinks.dbm.zip
114
115				An index that maps file names to other files. You shouldn't have to care
116				about it.
117				Details can be found in L.
118
119				=item scripts_dists.dbm.zip
120
121				An index that maps script names to file names.
122				Details can be found in L.
123
124				=item repository_info.yml
125
126				A simple YAML file which contains meta information for the repository.
127				It currently contains the following bits of information:
128
129				=item dbm_checksums.txt
130
131				A text file associating the DBM files with their MD5 checksums. (new in 0.15)
132
133				=over 2
134
135				=item repository_version
136
137				The version of PAR::Repository this repository was created with.
138				When opening an existing repository, PAR::Repository checks that the
139				repository was created by a compatible PAR::Repository version.
140
141				Similarily, PAR::Repository::Client checks that the repository has
142				a compatible version.
143
144				=back
145
146				=item I directories
147
148				Your system architecture is identified with a certain string.
149				For example, my development box is C.
150				For every such architecture for which there are PAR archives
151				in the repository, there is a directory with the name of the
152				architecture.
153
154				There is one special directory called C which is meant
155				for PAR archives that are architecture independent. (Usually
156				I modules.)
157
158				In every such architecture directory, there is a number of directories
159				for every Perl version. (5.6.0, 5.6.1, 5.8.0, ...)
160				Again, there is a special directory for modules
161				that work with any version of Perl.
162				This directory is called C.
163
164				Of course, a module won't run with Perl 4 and probably not even with
165				5.001. Whether a module works with I of perl is something
166				you need to decide when injecting modules into the repository and depends
167				on the scope of the repository.
168
169				These inner directories contain the PAR archives. The directories exist
170				mostly because large repositories with a lot of modules for a lot of
171				architectures would otherwise have too large directory lists.
172
173				=item PAR archives
174
175				Within the I directories come the actual PAR archives.
176				The name of each such file is of the following form:
177
178				I-I-I-I.par
179
180				=back
181
182				=head1 METHODS
183
184				Following is a list of class and instance methods.
185				(Instance methods until otherwise mentioned.)
186
187				Other methods callable on C objects are inherited
188				from classes listed in the I section.
189
190				=cut
191
192				=head2 new
193
194				Creates a new PAR::Repository object. Takes named arguments.
195
196				Mandatory paramater:
197
198				C should be the path to the
199				PAR repository. If the repository does not exist yet, it
200				is created empty. If the repository exists, it is I.
201				That means any modifications you apply to the repository object
202				are applied to the I repository on disk.
203
204				Optional parameters:
205
206				Additionally, you may supply the C 1>
207				or C 1> parameters. Both default to
208				false. I will convert an existing repository
209				that uses symbolic links to using no symbolic links as if it
210				had been created with the I option.
211				If the repository has to be created, I
212				flags it as using no symbolic links. Copies will be used instead.
213				this may result is a larger but more portable repository.
214				I implies I. See also I below.
215
216				I is the default for creating new repositories
217				on platforms which do not support symlinks.
218
219				=cut
220
221				sub new {
222				my $proto = shift;
223				my $class = ref($proto) \|\| $proto;
224
225				croak(__PACKAGE__."->new() takes an even number of arguments.")
226				if @_ % 2;
227				my %args = @_;
228
229				croak(__PACKAGE__."->new() needs a 'path' argument.")
230				if not defined $args{path};
231
232				my $path = $args{path};
233				my $self = bless {
234				path => $path,
235
236				# The tied dbm hashes
237				modules_hash => undef,
238				symlinks_hash => undef,
239				scripts_hash => undef,
240				dependencies_hash => undef,
241
242				# The temp dbm files on disk
243				modules_dbm_temp_file => undef,
244				symlinks_dbm_temp_file => undef,
245				scripts_dbm_temp_file => undef,
246				dependencies_dbm_temp_file => undef,
247
248				# The YAML info as Perl data structure
249				info => undef,
250				} => $class;
251
252				$self->verbose(2, "Created new repository object in path '$path'");
253
254				# check that the repository exists or create it.
255				my $mod_dbm = catfile($path, PAR::Repository::DBM::MODULES_DBM_FILE());
256				my $sym_dbm = catfile($path, PAR::Repository::DBM::SYMLINKS_DBM_FILE());
257				my $scr_dbm = catfile($path, PAR::Repository::DBM::SCRIPTS_DBM_FILE());
258				my $dep_dbm = catfile($path, PAR::Repository::DBM::DEPENDENCIES_DBM_FILE());
259				my $info_file = catfile($path, PAR::Repository::REPOSITORY_INFO_FILE());
260
261				if (-d $path
262				and -f $mod_dbm.'.zip' and -f $sym_dbm.'.zip'
263				and -f $info_file ) {
264				# everything is in place. good.
265				$self->verbose(3, "Repository exists");
266
267				# load repository info
268				$self->{info} = YAML::Syck::LoadFile($info_file);
269				if ( not defined $self->{info}
270				or not exists $self->{info}{repository_version} ) {
271				croak("Repository exists, but it does not contain a valid repository_info.yml file.");
272				}
273				elsif ( not exists $Compatible_Versions->{$self->{info}{repository_version}} ) {
274				croak("Repository exists, but it was created with an incompatible version of PAR::Repository (".$self->{info}{repository_version}.")");
275				}
276				# the following is a special case because the "incompatible changes
277				# with every "\d+.\d" release" rule was introduced in 0.10
278				elsif ( $Compatible_Versions->{$self->{info}{repository_version}} eq '0.03' ) {
279				$self->_update_info_version or return ();
280				$self->verbose(3, "Updated repository version");
281				}
282
283				if ($args{convert_symlinks}) {
284				$self->_convert_symlinks();
285				}
286
287				if (!$Supports_Symlinks and !$self->{info}{fake_symlinks}) {
288				croak("Repository may use symlinks but your platform does not support them. "
289				."Use the convert_symlinks => 1 option to the PAR::Repository constructor "
290				."to convert the repository to one which does not use symbolic links.");
291				}
292
293				$self->verbose(3, "Opened repository successfully");
294
295				# Generate scripts db and upgrade repository version
296				# if the scripts db doesn't exist.
297				if (not -f $scr_dbm.'.zip') {
298				$self->verbose(1, "Upgrading repository version to $VERSION");
299				$self->_update_info_version or return ();
300				$self->verbose(3, "Creating scripts database");
301				$self->_create_dbm($scr_dbm.'.zip');
302				}
303
304				# Generate deps db and upgrade repository version
305				# if the deps db doesn't exist.
306				if (not -f $dep_dbm.'.zip') {
307				$self->verbose(1, "Upgrading repository version to $VERSION");
308				$self->_update_info_version or return ();
309				$self->verbose(3, "Creating dependencies database");
310				$self->_create_dbm($dep_dbm.'.zip');
311				}
312
313				} # end if everything is in place
314				else {
315				$self->verbose(3, "Repository doesn't exist yet");
316				$self->_create_repository($path, !$Supports_Symlinks\|\|$args{fake_symlinks});
317				}
318
319				return $self;
320				}
321
322				# creates a new repository
323				# called by the constructor if the directory doesn't exist
324				sub _create_repository {
325				my $self = shift;
326				my $path = shift;
327				my $fake_symlinks = shift;
328
329				if (-d $path) {
330				croak("The repository path exists, but is not a repository. Delete it to create a new repository.");
331				}
332				mkpath([$path]);
333
334				my $mod_dbm = catfile($path, PAR::Repository::DBM::MODULES_DBM_FILE());
335				my $sym_dbm = catfile($path, PAR::Repository::DBM::SYMLINKS_DBM_FILE());
336				my $scr_dbm = catfile($path, PAR::Repository::DBM::SCRIPTS_DBM_FILE());
337				my $dep_dbm = catfile($path, PAR::Repository::DBM::DEPENDENCIES_DBM_FILE());
338				my $info_file = catfile($path, PAR::Repository::REPOSITORY_INFO_FILE());
339
340				$self->verbose(3, "Creating repository databases");
341				foreach my $dbm ($mod_dbm, $sym_dbm, $scr_dbm, $dep_dbm) {
342				$self->_create_dbm($dbm.'.zip');
343				}
344
345				my $info_copy = {%$Info_Template};
346				$info_copy->{fake_symlinks} = 1 if $fake_symlinks;
347				YAML::Syck::DumpFile($info_file, $info_copy);
348				$self->{info} = YAML::Syck::LoadFile($info_file);
349				}
350
351				# converts all symlinks to files, sets {info}->{fake_symlinks},
352				# and saves it
353				# called by the constructor
354				sub _convert_symlinks {
355				my $self = shift;
356				$self->{error} = undef;
357				$self->verbose(1, "Converting symlinks to files!");
358
359				# change to repo path
360				my $old_dir = Cwd::cwd();
361				chdir($self->{path});
362
363				my $info_file = catfile($self->{path}, PAR::Repository::REPOSITORY_INFO_FILE());
364
365				my ($symdbm, $temp_file) = $self->symlinks_dbm;
366				while (my ($file, $symlinks) = each %$symdbm) {
367				my ($distname, $distver, $arch, $perlver) = PAR::Dist::parse_dist_name($file);
368				my $file_fullpath = File::Spec->catfile($arch, $perlver, $file);
369
370				foreach my $symlink_file (@$symlinks) {
371				my ($distname, $distver, $arch, $perlver) = PAR::Dist::parse_dist_name($symlink_file);
372				my $symlink_file_fullpath = File::Spec->catfile($arch, $perlver, $symlink_file);
373				# first unlink or else File::Copy may claim it can't copy because the files are
374				# the same.
375				(unlink( $symlink_file_fullpath ) and File::Copy::copy( $file_fullpath, $symlink_file_fullpath ))
376				or chdir($old_dir),
377				die "Error converting symlinks in repository to real files: Could not copy "
378				."'$file' to '$symlink_file'. Your repository may be in an inconsistent "
379				."state now. Reason: $!";
380				}
381				}
382				chdir($old_dir);
383
384				$self->{info}{fake_symlinks} = 1;
385				YAML::Syck::DumpFile($info_file, $self->{info});
386				$self->{info} = YAML::Syck::LoadFile($info_file);
387				return 1;
388				}
389
390				=head2 inject
391
392				Injects a new PAR distribution into the repository. Takes named parameters.
393
394				Mandatory parameters: I, the path and filename of the PAR distribution
395				to inject. The name of the file can be used to automatically determine the
396				I, I, I, and I parameters if the
397				form of the file name is as follows:
398
399				Dist-Name-0.01-x86_64-linux-gnu-thread-multi-5.8.7.par
400
401				This would set C 'Dist-Name', distversion => '0.01',
402				arch => 'linux-gnu-thread-multi', perlversion => '5.8.7'>. You can override
403				this automatic detection using the corresponding parameters.
404
405				If the file exists in the repository, inject returns false. If the file
406				was added successfully, inject returns true. See the C parameter
407				for details.
408
409				C scans the distribution for modules and indexes these in
410				the modules-dists dbm. Additionally, it scans the distribution for
411				scripts in the C