Introduce ad hoc requirements and add skip_without method to optdeps
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Optional / Dependencies.pm
1 package DBIx::Class::Optional::Dependencies;
2
3 ### This may look crazy, but it in fact tangibly ( by 50(!)% ) shortens
4 #   the skip-test time when everything requested is unavailable
5 use if $ENV{RELEASE_TESTING} => 'warnings';
6 use if $ENV{RELEASE_TESTING} => 'strict';
7
8 sub croak {
9   require Carp;
10   Carp::croak(@_);
11 };
12 ###
13
14 # NO EXTERNAL NON-5.8.1 CORE DEPENDENCIES EVER (e.g. C::A::G)
15 # This module is to be loaded by Makefile.PM on a pristine system
16
17 # POD is generated automatically by calling _gen_pod from the
18 # Makefile.PL in $AUTHOR mode
19
20 # *DELIBERATELY* not making a group for these - they must disappear
21 # forever as optdeps in the first place
22 my $moose_basic = {
23   'Moose'                         => '0.98',
24   'MooseX::Types'                 => '0.21',
25   'MooseX::Types::LoadableClass'  => '0.011',
26 };
27
28 my $dbic_reqs = {
29
30   # NOTE: the rationale for 2 JSON::Any versions is that
31   # we need the newer only to work around JSON::XS, which
32   # itself is an optional dep
33   _json_any => {
34     req => {
35       'JSON::Any' => '1.23',
36     },
37   },
38
39   _json_xs_compatible_json_any => {
40     req => {
41       'JSON::Any' => '1.31',
42     },
43   },
44
45   # a common placeholder for engines with IC::DT support based off DT::F::S
46   _icdt_strptime_based => {
47     augment => {
48       icdt => {
49         req => {
50           'DateTime::Format::Strptime' => '1.2',
51         },
52       },
53     }
54   },
55
56   _rdbms_generic_odbc => {
57     req => {
58       'DBD::ODBC' => 0,
59     }
60   },
61
62   _rdbms_generic_ado => {
63     req => {
64       'DBD::ADO' => 0,
65     }
66   },
67
68   # must list any dep used by adhoc testing
69   # this prevents the "skips due to forgotten deps" issue
70   test_adhoc => {
71     req => {
72       'Date::Simple' => '3.03',
73       'YAML' => '0',
74       'Class::Unload' => '0.07',
75     },
76   },
77
78   replicated => {
79     req => $moose_basic,
80     pod => {
81       title => 'Storage::Replicated',
82       desc => 'Modules required for L<DBIx::Class::Storage::DBI::Replicated>',
83     },
84   },
85
86   test_replicated => {
87     include => 'replicated',
88     req => {
89       'Test::Moose' => '0',
90     },
91   },
92
93   admin => {
94     include => '_json_any',
95     req => {
96       %$moose_basic,
97       'MooseX::Types::Path::Class' => '0.05',
98       'MooseX::Types::JSON' => '0.02',
99     },
100     pod => {
101       title => 'DBIx::Class::Admin',
102       desc => 'Modules required for the DBIx::Class administrative library',
103     },
104   },
105
106   admin_script => {
107     include => 'admin',
108     req => {
109       'Getopt::Long::Descriptive' => '0.081',
110       'Text::CSV' => '1.16',
111     },
112     pod => {
113       title => 'dbicadmin',
114       desc => 'Modules required for the CLI DBIx::Class interface dbicadmin',
115     },
116   },
117
118   deploy => {
119     req => {
120       'SQL::Translator'           => '0.11018',
121     },
122     pod => {
123       title => 'Storage::DBI::deploy()',
124       desc => 'Modules required for L<DBIx::Class::Storage::DBI/deployment_statements> and L<DBIx::Class::Schema/deploy>',
125     },
126   },
127
128   icdt => {
129     req => {
130       'DateTime' => '0.55',
131     },
132     pod => {
133       title => 'InflateColumn::DateTime support',
134       desc =>
135         'Modules required for L<DBIx::Class::InflateColumn::DateTime>. '
136       . 'Note that this group does not require much on its own, but '
137       . 'instead is augmented by various RDBMS-specific groups. See the '
138       . 'documentation of each C<rbms_*> group for details',
139     },
140   },
141
142   id_shortener => {
143     req => {
144       'Math::BigInt' => '1.80',
145       'Math::Base36' => '0.07',
146     },
147   },
148
149   test_pod => {
150     req => {
151       'Test::Pod'                 => '1.42',
152     },
153     release_testing_mandatory => 1,
154   },
155
156   test_podcoverage => {
157     req => {
158       'Test::Pod::Coverage'       => '1.08',
159       'Pod::Coverage'             => '0.20',
160     },
161     release_testing_mandatory => 1,
162   },
163
164   test_whitespace => {
165     req => {
166       'Test::EOL'                 => '1.0',
167       'Test::NoTabs'              => '0.9',
168     },
169     release_testing_mandatory => 1,
170   },
171
172   test_strictures => {
173     req => {
174       'Test::Strict'              => '0.20',
175     },
176     release_testing_mandatory => 1,
177   },
178
179   test_prettydebug => {
180     include => '_json_any',
181   },
182
183   test_admin_script => {
184     include => [qw( admin_script _json_xs_compatible_json_any )],
185     req => {
186       'JSON' => 0,
187       'JSON::PP' => 0,
188       'Cpanel::JSON::XS' => 0,
189       'JSON::XS' => 0,
190       $^O eq 'MSWin32'
191         # for t/admin/10script.t
192         ? ('Win32::ShellQuote' => 0)
193         # DWIW does not compile (./configure even) on win32
194         : ('JSON::DWIW' => 0 )
195       ,
196     }
197   },
198
199   test_leaks_heavy => {
200     req => {
201       'Class::MethodCache' => '0.02',
202       'PadWalker' => '1.06',
203     },
204   },
205
206   test_cdbicompat => {
207     include => 'icdt',
208     req => {
209       'Class::DBI::Plugin::DeepAbstractSearch' => '0',
210       'Time::Piece::MySQL'        => '0',
211     },
212   },
213
214   # this is just for completeness as SQLite
215   # is a core dep of DBIC for testing
216   rdbms_sqlite => {
217     req => {
218       'DBD::SQLite' => 0,
219     },
220     pod => {
221       title => 'SQLite support',
222       desc => 'Modules required to connect to SQLite',
223     },
224     augment => {
225       icdt => {
226         req => {
227           'DateTime::Format::SQLite' => '0',
228         },
229       },
230     },
231   },
232
233   # centralize the specification, as we have ICDT tests which can
234   # test the full behavior of RDBMS-specific ICDT on top of bare SQLite
235   # not _-prefixed so that it will show up under req_group_list
236   icdt_pg => {
237     augment => {
238       icdt => {
239         req => {
240           'DateTime::Format::Pg' => '0.16004',
241         },
242       },
243     },
244   },
245
246   rdbms_pg => {
247     include => 'icdt_pg',
248     req => {
249       # when changing this list make sure to adjust xt/optional_deps.t
250       'DBD::Pg' => 0,
251     },
252     pod => {
253       title => 'PostgreSQL support',
254       desc => 'Modules required to connect to PostgreSQL',
255     },
256   },
257
258   _rdbms_mssql_common => {
259     include => '_icdt_strptime_based',
260   },
261
262   rdbms_mssql_odbc => {
263     include => [qw( _rdbms_generic_odbc _rdbms_mssql_common )],
264     pod => {
265       title => 'MSSQL support via DBD::ODBC',
266       desc => 'Modules required to connect to MSSQL via DBD::ODBC',
267     },
268   },
269
270   rdbms_mssql_sybase => {
271     include => '_rdbms_mssql_common',
272     req => {
273       'DBD::Sybase' => 0,
274     },
275     pod => {
276       title => 'MSSQL support via DBD::Sybase',
277       desc => 'Modules required to connect to MSSQL via DBD::Sybase',
278     },
279   },
280
281   rdbms_mssql_ado => {
282     include => [qw( _rdbms_generic_ado _rdbms_mssql_common )],
283     pod => {
284       title => 'MSSQL support via DBD::ADO (Windows only)',
285       desc => 'Modules required to connect to MSSQL via DBD::ADO. This particular DBD is available on Windows only',
286     },
287   },
288
289   _rdbms_msaccess_common => {
290     include => '_icdt_strptime_based',
291   },
292
293   rdbms_msaccess_odbc => {
294     include => [qw( _rdbms_generic_odbc _rdbms_msaccess_common )],
295     pod => {
296       title => 'MS Access support via DBD::ODBC',
297       desc => 'Modules required to connect to MS Access via DBD::ODBC',
298     },
299   },
300
301   rdbms_msaccess_ado => {
302     include => [qw( _rdbms_generic_ado _rdbms_msaccess_common )],
303     pod => {
304       title => 'MS Access support via DBD::ADO (Windows only)',
305       desc => 'Modules required to connect to MS Access via DBD::ADO. This particular DBD is available on Windows only',
306     },
307   },
308
309   # centralize the specification, as we have ICDT tests which can
310   # test the full behavior of RDBMS-specific ICDT on top of bare SQLite
311   # not _-prefixed so that it will show up under req_group_list
312   icdt_mysql => {
313     augment => {
314       icdt => {
315         req => {
316           'DateTime::Format::MySQL' => '0',
317         },
318       },
319     },
320   },
321
322   rdbms_mysql => {
323     include => 'icdt_mysql',
324     req => {
325       'DBD::mysql' => 0,
326     },
327     pod => {
328       title => 'MySQL support',
329       desc => 'Modules required to connect to MySQL',
330     },
331   },
332
333   rdbms_oracle => {
334     include => 'id_shortener',
335     req => {
336       'DBD::Oracle' => 0,
337     },
338     pod => {
339       title => 'Oracle support',
340       desc => 'Modules required to connect to Oracle',
341     },
342     augment => {
343       icdt => {
344         req => {
345           'DateTime::Format::Oracle' => '0',
346         },
347       },
348     },
349   },
350
351   rdbms_ase => {
352     include => '_icdt_strptime_based',
353     req => {
354       'DBD::Sybase' => 0,
355     },
356     pod => {
357       title => 'Sybase ASE support',
358       desc => 'Modules required to connect to Sybase ASE',
359     },
360   },
361
362   _rdbms_db2_common => {
363     augment => {
364       icdt => {
365         req => {
366           'DateTime::Format::DB2' => '0',
367         },
368       },
369     },
370   },
371
372   rdbms_db2 => {
373     include => '_rdbms_db2_common',
374     req => {
375       'DBD::DB2' => 0,
376     },
377     pod => {
378       title => 'DB2 support',
379       desc => 'Modules required to connect to DB2',
380     },
381   },
382
383   rdbms_db2_400 => {
384     include => [qw( _rdbms_generic_odbc _rdbms_db2_common )],
385     pod => {
386       title => 'DB2 on AS/400 support',
387       desc => 'Modules required to connect to DB2 on AS/400',
388     },
389   },
390
391   rdbms_informix => {
392     include => '_icdt_strptime_based',
393     req => {
394       'DBD::Informix' => 0,
395     },
396     pod => {
397       title => 'Informix support',
398       desc => 'Modules required to connect to Informix',
399     },
400   },
401
402   _rdbms_sqlanywhere_common => {
403     inclide => '_icdt_strptime_based',
404   },
405
406   rdbms_sqlanywhere => {
407     include => '_rdbms_sqlanywhere_common',
408     req => {
409       'DBD::SQLAnywhere' => 0,
410     },
411     pod => {
412       title => 'SQLAnywhere support',
413       desc => 'Modules required to connect to SQLAnywhere',
414     },
415   },
416
417   rdbms_sqlanywhere_odbc => {
418     include => [qw( _rdbms_generic_odbc _rdbms_sqlanywhere_common )],
419     pod => {
420       title => 'SQLAnywhere support via DBD::ODBC',
421       desc => 'Modules required to connect to SQLAnywhere via DBD::ODBC',
422     },
423   },
424
425   _rdbms_firebird_common => {
426     include => '_icdt_strptime_based',
427   },
428
429   rdbms_firebird => {
430     include => '_rdbms_firebird_common',
431     req => {
432       'DBD::Firebird' => 0,
433     },
434     pod => {
435       title => 'Firebird support',
436       desc => 'Modules required to connect to Firebird',
437     },
438   },
439
440   rdbms_firebird_interbase => {
441     include => '_rdbms_firebird_common',
442     req => {
443       'DBD::InterBase' => 0,
444     },
445     pod => {
446       title => 'Firebird support via DBD::InterBase',
447       desc => 'Modules required to connect to Firebird via DBD::InterBase',
448     },
449   },
450
451   rdbms_firebird_odbc => {
452     include => [qw( _rdbms_generic_odbc _rdbms_firebird_common )],
453     pod => {
454       title => 'Firebird support via DBD::ODBC',
455       desc => 'Modules required to connect to Firebird via DBD::ODBC',
456     },
457   },
458
459   test_rdbms_sqlite => {
460     include => 'rdbms_sqlite',
461     req => {
462       ###
463       ### IMPORTANT - do not raise this dependency
464       ### even though many bugfixes are present in newer versions, the general DBIC
465       ### rule is to bend over backwards for available DBDs (given upgrading them is
466       ### often *not* easy or even possible)
467       ###
468       'DBD::SQLite' => '1.29',
469     },
470   },
471
472   test_rdbms_pg => {
473     include => 'rdbms_pg',
474     env => [
475       DBICTEST_PG_DSN => 1,
476       DBICTEST_PG_USER => 0,
477       DBICTEST_PG_PASS => 0,
478     ],
479     req => {
480       # the order does matter because the rdbms support group might require
481       # a different version that the test group
482       #
483       # when changing this list make sure to adjust xt/optional_deps.t
484       'DBD::Pg' => '2.009002',  # specific version to test bytea
485     },
486   },
487
488   test_rdbms_mssql_odbc => {
489     include => 'rdbms_mssql_odbc',
490     env => [
491       DBICTEST_MSSQL_ODBC_DSN => 1,
492       DBICTEST_MSSQL_ODBC_USER => 0,
493       DBICTEST_MSSQL_ODBC_PASS => 0,
494     ],
495   },
496
497   test_rdbms_mssql_ado => {
498     include => 'rdbms_mssql_ado',
499     env => [
500       DBICTEST_MSSQL_ADO_DSN => 1,
501       DBICTEST_MSSQL_ADO_USER => 0,
502       DBICTEST_MSSQL_ADO_PASS => 0,
503     ],
504   },
505
506   test_rdbms_mssql_sybase => {
507     include => 'rdbms_mssql_sybase',
508     env => [
509       DBICTEST_MSSQL_DSN => 1,
510       DBICTEST_MSSQL_USER => 0,
511       DBICTEST_MSSQL_PASS => 0,
512     ],
513   },
514
515   test_rdbms_msaccess_odbc => {
516     include => 'rdbms_msaccess_odbc',
517     env => [
518       DBICTEST_MSACCESS_ODBC_DSN => 1,
519       DBICTEST_MSACCESS_ODBC_USER => 0,
520       DBICTEST_MSACCESS_ODBC_PASS => 0,
521     ],
522     req => {
523       'Data::GUID' => '0',
524     },
525   },
526
527   test_rdbms_msaccess_ado => {
528     include => 'rdbms_msaccess_ado',
529     env => [
530       DBICTEST_MSACCESS_ADO_DSN => 1,
531       DBICTEST_MSACCESS_ADO_USER => 0,
532       DBICTEST_MSACCESS_ADO_PASS => 0,
533     ],
534     req => {
535       'Data::GUID' => 0,
536     },
537   },
538
539   test_rdbms_mysql => {
540     include => 'rdbms_mysql',
541     env => [
542       DBICTEST_MYSQL_DSN => 1,
543       DBICTEST_MYSQL_USER => 0,
544       DBICTEST_MYSQL_PASS => 0,
545     ],
546   },
547
548   test_rdbms_oracle => {
549     include => 'rdbms_oracle',
550     env => [
551       DBICTEST_ORA_DSN => 1,
552       DBICTEST_ORA_USER => 0,
553       DBICTEST_ORA_PASS => 0,
554     ],
555     req => {
556       'DBD::Oracle'              => '1.24',
557     },
558   },
559
560   test_rdbms_ase => {
561     include => 'rdbms_ase',
562     env => [
563       DBICTEST_SYBASE_DSN => 1,
564       DBICTEST_SYBASE_USER => 0,
565       DBICTEST_SYBASE_PASS => 0,
566     ],
567   },
568
569   test_rdbms_db2 => {
570     include => 'rdbms_db2',
571     env => [
572       DBICTEST_DB2_DSN => 1,
573       DBICTEST_DB2_USER => 0,
574       DBICTEST_DB2_PASS => 0,
575     ],
576   },
577
578   test_rdbms_db2_400 => {
579     include => 'rdbms_db2_400',
580     env => [
581       DBICTEST_DB2_400_DSN => 1,
582       DBICTEST_DB2_400_USER => 0,
583       DBICTEST_DB2_400_PASS => 0,
584     ],
585   },
586
587   test_rdbms_informix => {
588     include => 'rdbms_informix',
589     env => [
590       DBICTEST_INFORMIX_DSN => 1,
591       DBICTEST_INFORMIX_USER => 0,
592       DBICTEST_INFORMIX_PASS => 0,
593     ],
594   },
595
596   test_rdbms_sqlanywhere => {
597     include => 'rdbms_sqlanywhere',
598     env => [
599       DBICTEST_SQLANYWHERE_DSN => 1,
600       DBICTEST_SQLANYWHERE_USER => 0,
601       DBICTEST_SQLANYWHERE_PASS => 0,
602     ],
603   },
604
605   test_rdbms_sqlanywhere_odbc => {
606     include => 'rdbms_sqlanywhere_odbc',
607     env => [
608       DBICTEST_SQLANYWHERE_ODBC_DSN => 1,
609       DBICTEST_SQLANYWHERE_ODBC_USER => 0,
610       DBICTEST_SQLANYWHERE_ODBC_PASS => 0,
611     ],
612   },
613
614   test_rdbms_firebird => {
615     include => 'rdbms_firebird',
616     env => [
617       DBICTEST_FIREBIRD_DSN => 1,
618       DBICTEST_FIREBIRD_USER => 0,
619       DBICTEST_FIREBIRD_PASS => 0,
620     ],
621   },
622
623   test_rdbms_firebird_interbase => {
624     include => 'rdbms_firebird_interbase',
625     env => [
626       DBICTEST_FIREBIRD_INTERBASE_DSN => 1,
627       DBICTEST_FIREBIRD_INTERBASE_USER => 0,
628       DBICTEST_FIREBIRD_INTERBASE_PASS => 0,
629     ],
630   },
631
632   test_rdbms_firebird_odbc => {
633     include => 'rdbms_firebird_odbc',
634     env => [
635       DBICTEST_FIREBIRD_ODBC_DSN => 1,
636       DBICTEST_FIREBIRD_ODBC_USER => 0,
637       DBICTEST_FIREBIRD_ODBC_PASS => 0,
638     ],
639   },
640
641   test_memcached => {
642     env => [
643       DBICTEST_MEMCACHED => 1,
644     ],
645     req => {
646       'Cache::Memcached' => 0,
647     },
648   },
649
650   dist_dir => {
651     # we need to run the dbicadmin so we can self-generate its POD
652     # also we do not want surprises in case JSON::XS is in the path
653     # so make sure we get an always-working JSON::Any
654     include => [qw( admin_script _json_xs_compatible_json_any )],
655     req => {
656       'ExtUtils::MakeMaker' => '6.64',
657       'Pod::Inherit'        => '0.91',
658     },
659   },
660
661   dist_upload => {
662     req => {
663       'CPAN::Uploader' => '0.103001',
664     },
665   },
666 };
667
668
669
670 ### Public API
671
672 sub import {
673   my $class = shift;
674
675   if (@_) {
676
677     my $action = shift;
678
679     if ($action eq '-die_without') {
680       my $err;
681       {
682         local $@;
683         eval { $class->die_unless_req_ok_for(\@_); 1 }
684           or $err = $@;
685       }
686       die "\n$err\n" if $err;
687     }
688     elsif ($action eq '-list_missing') {
689       print $class->modreq_missing_for(\@_);
690       print "\n";
691       exit 0;
692     }
693     elsif ($action eq '-skip_all_without') {
694
695       # sanity check - make sure ->current_test is 0 and no plan has been declared
696       do {
697         local $@;
698         defined eval {
699           Test::Builder->new->current_test
700             or
701           Test::Builder->new->has_plan
702         };
703       } and croak("Unable to invoke -skip_all_without after testing has started");
704
705       if ( my $missing = $class->req_missing_for(\@_) ) {
706
707         die ("\nMandatory requirements not satisfied during release-testing: $missing\n\n")
708           if $ENV{RELEASE_TESTING} and $class->_groups_to_reqs(\@_)->{release_testing_mandatory};
709
710         print "1..0 # SKIP requirements not satisfied: $missing\n";
711         exit 0;
712       }
713     }
714     elsif ($action =~ /^-/) {
715       croak "Unknown import-time action '$action'";
716     }
717     else {
718       croak "$class is not an exporter, unable to import '$action'";
719     }
720   }
721
722   1;
723 }
724
725 sub unimport {
726   croak( __PACKAGE__ . " does not implement unimport" );
727 }
728
729 # OO for (mistakenly considered) ease of extensibility, not due to any need to
730 # carry state of any sort. This API is currently used outside, so leave as-is.
731 # FIXME - make sure to not propagate this further if module is extracted as a
732 # standalone library - keep the stupidity to a DBIC-secific shim!
733 #
734 sub req_list_for {
735   shift->_groups_to_reqs(shift)->{effective_modreqs};
736 }
737
738 sub modreq_list_for {
739   shift->_groups_to_reqs(shift)->{modreqs};
740 }
741
742 sub req_group_list {
743   +{ map
744     { $_ => $_[0]->_groups_to_reqs($_) }
745     grep { $_ !~ /^_/ } keys %$dbic_reqs
746   }
747 }
748
749 sub req_errorlist_for { shift->modreq_errorlist_for(shift) }  # deprecated
750 sub modreq_errorlist_for {
751   my ($self, $groups) = @_;
752   $self->_errorlist_for_modreqs( $self->_groups_to_reqs($groups)->{modreqs} );
753 }
754
755 sub req_ok_for {
756   shift->req_missing_for(shift) ? 0 : 1;
757 }
758
759 sub req_missing_for {
760   my ($self, $groups) = @_;
761
762   my $reqs = $self->_groups_to_reqs($groups);
763   my $mods_missing = $self->modreq_missing_for($groups);
764
765   return '' if
766     ! $mods_missing
767       and
768     ! $reqs->{missing_envvars}
769   ;
770
771   my @res = $mods_missing || ();
772
773   push @res, 'the following group(s) of environment variables: ' . join ' and ', sort map
774     { __envvar_group_desc($_) }
775     @{$reqs->{missing_envvars}}
776   if $reqs->{missing_envvars};
777
778   return (
779     ( join ' as well as ', @res )
780       .
781     ( $reqs->{modreqs_fully_documented} ? " (see @{[ ref $self || $self ]} documentation for details)" : '' ),
782   );
783 }
784
785 sub modreq_missing_for {
786   my ($self, $groups) = @_;
787
788   my $reqs = $self->_groups_to_reqs($groups);
789   my $modreq_errors = $self->_errorlist_for_modreqs($reqs->{modreqs})
790     or return '';
791
792   join ' ', map
793     { $reqs->{modreqs}{$_} ? qq("$_~>=$reqs->{modreqs}{$_}") : $_ }
794     sort { lc($a) cmp lc($b) } keys %$modreq_errors
795   ;
796 }
797
798 my $tb;
799 sub skip_without {
800   my ($self, $groups) = @_;
801
802   $tb ||= do { local $@; eval { Test::Builder->new } }
803     or croak "Calling skip_without() before loading Test::Builder makes no sense";
804
805   if ( my $err = $self->req_missing_for($groups) ) {
806     my ($fn, $ln) = (caller(0))[1,2];
807     $tb->skip("block in $fn around line $ln requires $err");
808     local $^W = 0;
809     last SKIP;
810   }
811
812   1;
813 }
814
815 sub die_unless_req_ok_for {
816   if (my $err = shift->req_missing_for(shift) ) {
817     die "Unable to continue due to missing requirements: $err\n";
818   }
819 }
820
821
822
823 ### Private functions
824
825 # potentially shorten group desc
826 sub __envvar_group_desc {
827   my @envs = @{$_[0]};
828
829   my (@res, $last_prefix);
830   while (my $ev = shift @envs) {
831     my ($pref, $sep, $suff) = split / ([\_\-]) (?= [^\_\-]+ \z )/x, $ev;
832
833     if ( defined $sep and ($last_prefix||'') eq $pref ) {
834         push @res, "...${sep}${suff}"
835     }
836     else {
837       push @res, $ev;
838     }
839
840     $last_prefix = $pref if $sep;
841   }
842
843   join '/', @res;
844 }
845
846 my $groupname_re = qr/ [A-Z_a-z][0-9A-Z_a-z]* /x;
847 my $modname_re = qr/ [A-Z_a-z] [0-9A-Z_a-z]* (?:::[0-9A-Z_a-z]+)* /x;
848 my $modver_re = qr/ [0-9]+ (?: \. [0-9]+ )? /x;
849
850 # Expand includes from a random group in a specific order:
851 # nonvariable groups first, then their includes, then the variable groups,
852 # then their includes.
853 # This allows reliably marking the rest of the mod reqs as variable (this is
854 # also why variable includes are currently not allowed)
855 sub __expand_includes {
856   my ($groups, $seen) = @_;
857
858   # !! DIFFERENT !! behavior and return depending on invocation mode
859   # (easier to recurse this way)
860   my $is_toplevel = $seen
861     ? 0
862     : !! ($seen = {})
863   ;
864
865   my ($res_per_type, $missing_envvars);
866
867   # breadth-first evaluation, with non-variable includes on top
868   for my $g (@$groups) {
869
870     croak "Invalid requirement group name '$g': only ascii alphanumerics and _ are allowed"
871       if $g !~ qr/ \A $groupname_re \z/x;
872
873     my $r = $dbic_reqs->{$g}
874       or croak "Requirement group '$g' is not defined";
875
876     # always do this check *before* the $seen check
877     croak "Group '$g' with variable effective_modreqs can not be specified as an 'include'"
878       if ( $r->{env} and ! $is_toplevel );
879
880     next if $seen->{$g}++;
881
882     my $req_type = 'static';
883
884     if ( my @e = @{$r->{env}||[]} ) {
885
886       croak "Unexpected 'env' attribute under group '$g' (only allowed in test_* groups)"
887         unless $g =~ /^test_/;
888
889       croak "Unexpected *odd* list in 'env' under group '$g'"
890         if @e % 2;
891
892       # deconstruct the whole thing
893       my (@group_envnames_list, $some_envs_required, $some_required_missing);
894       while (@e) {
895         push @group_envnames_list, my $envname = shift @e;
896
897         # env required or not
898         next unless shift @e;
899
900         $some_envs_required ||= 1;
901
902         $some_required_missing ||= (
903           ! defined $ENV{$envname}
904             or
905           ! length $ENV{$envname}
906         );
907       }
908
909       croak "None of the envvars in group '$g' declared as required, making the requirement moot"
910         unless $some_envs_required;
911
912       if ($some_required_missing) {
913         push @{$missing_envvars->{$g}}, \@group_envnames_list;
914         $req_type = 'variable';
915       }
916     }
917
918     push @{$res_per_type->{"base_${req_type}"}}, $g;
919
920     if (my $i = $dbic_reqs->{$g}{include}) {
921       $i = [ $i ] unless ref $i eq 'ARRAY';
922
923       croak "Malformed 'include' for group '$g': must be another existing group name or arrayref of existing group names"
924         unless @$i;
925
926       push @{$res_per_type->{"incs_${req_type}"}}, @$i;
927     }
928   }
929
930   my @ret = map {
931     @{ $res_per_type->{"base_${_}"} || [] },
932     ( $res_per_type->{"incs_${_}"} ? __expand_includes( $res_per_type->{"incs_${_}"}, $seen ) : () ),
933   } qw(static variable);
934
935   return ! $is_toplevel ? @ret : do {
936     my $rv = {};
937     $rv->{$_} = {
938       idx => 1 + keys %$rv,
939       missing_envvars => $missing_envvars->{$_},
940     } for @ret;
941     $rv->{$_}{user_requested} = 1 for @$groups;
942     $rv;
943   };
944 }
945
946 ### Private OO API
947 our %req_unavailability_cache;
948
949 # this method is just a lister and envvar/metadata checker - it does not try to load anything
950 sub _groups_to_reqs {
951   my ($self, $want) = @_;
952
953   $want = [ $want || () ]
954     unless ref $want eq 'ARRAY';
955
956   croak "@{[ (caller(1))[3] ]}() expects a requirement group name or arrayref of group names"
957     unless @$want;
958
959   my $ret = {
960     modreqs => {},
961     modreqs_fully_documented => 1,
962   };
963
964   my $groups;
965   for my $piece (@$want) {
966     if ($piece =~ qr/ \A $groupname_re \z /x) {
967       push @$groups, $piece;
968     }
969     elsif ( my ($mod, $ver) = $piece =~ qr/ \A ($modname_re) \>\= ($modver_re) \z /x ) {
970       croak "Ad hoc module specification lists '$mod' twice"
971         if exists $ret->{modreqs}{$mod};
972
973       croak "Ad hoc module specification '${mod} >= $ver' (or greater) not listed in the test_adhoc optdep group" if (
974         ! defined $dbic_reqs->{test_adhoc}{req}{$mod}
975           or
976         $dbic_reqs->{test_adhoc}{req}{$mod} < $ver
977       );
978
979       $ret->{modreqs}{$mod} = $ver;
980       $ret->{modreqs_fully_documented} = 0;
981     }
982     else {
983       croak "Unsupported argument '$piece' supplied to @{[ (caller(1))[3] ]}()"
984     }
985   }
986
987   my $all_groups = __expand_includes($groups);
988
989   # pre-assemble list of augmentations, perform basic sanity checks
990   # Note that below we *DO NOT* respect the source/target reationship, but
991   # instead always default to augment the "later" group
992   # This is done so that the "stable/variable" boundary keeps working as
993   # expected
994   my $augmentations;
995   for my $requesting_group (keys %$all_groups) {
996     if (my $ag = $dbic_reqs->{$requesting_group}{augment}) {
997       for my $target_group (keys %$ag) {
998
999         croak "Group '$requesting_group' claims to augment a non-existent group '$target_group'"
1000           unless $dbic_reqs->{$target_group};
1001
1002         croak "Augmentation combined with variable effective_modreqs currently unsupported for group '$requesting_group'"
1003           if $dbic_reqs->{$requesting_group}{env};
1004
1005         croak "Augmentation of group '$target_group' with variable effective_modreqs unsupported (requested by '$requesting_group')"
1006           if $dbic_reqs->{$target_group}{env};
1007
1008         if (my @foreign = grep { $_ ne 'req' } keys %{$ag->{$target_group}} ) {
1009           croak "Only 'req' augmentations are currently supported (group '$requesting_group' attempts to alter '$foreign[0]' of group '$target_group'";
1010         }
1011
1012         $ret->{augments}{$target_group} = 1;
1013
1014         # no augmentation for stuff that hasn't been selected
1015         if ( $all_groups->{$target_group} and my $ar = $ag->{$target_group}{req} ) {
1016           push @{$augmentations->{
1017             ( $all_groups->{$requesting_group}{idx} < $all_groups->{$target_group}{idx} )
1018               ? $target_group
1019               : $requesting_group
1020           }}, $ar;
1021         }
1022       }
1023     }
1024   }
1025
1026   for my $group (sort { $all_groups->{$a}{idx} <=> $all_groups->{$b}{idx} } keys %$all_groups ) {
1027
1028     my $group_reqs = $dbic_reqs->{$group}{req};
1029
1030     # sanity-check
1031     for my $req_bag ($group_reqs, @{ $augmentations->{$group} || [] } ) {
1032       for (keys %$req_bag) {
1033
1034         $_ =~ / \A $modname_re \z /x
1035           or croak "Requirement '$_' in group '$group' is not a valid module name";
1036
1037         # !!!DO NOT CHANGE!!!
1038         # remember - version.pm may not be available on the system
1039         croak "Requirement '$_' in group '$group' specifies an invalid version '$req_bag->{$_}' (only plain non-underscored floating point decimals are supported)"
1040           if ( ($req_bag->{$_}||0) !~ qr/ \A $modver_re \z /x );
1041       }
1042     }
1043
1044     if (my $e = $all_groups->{$group}{missing_envvars}) {
1045       push @{$ret->{missing_envvars}}, @$e;
1046     }
1047
1048     # assemble into the final ret
1049     for my $type (
1050       'modreqs',
1051       ( $ret->{missing_envvars} ? () : 'effective_modreqs' ),
1052     ) {
1053       for my $req_bag ($group_reqs, @{ $augmentations->{$group} || [] } ) {
1054         for my $mod (keys %$req_bag) {
1055
1056           $ret->{$type}{$mod} = $req_bag->{$mod}||0 if (
1057
1058             ! exists $ret->{$type}{$mod}
1059               or
1060             # we sanitized the version to be numeric above - we can just -gt it
1061             ($req_bag->{$mod}||0) > $ret->{$type}{$mod}
1062
1063           );
1064         }
1065       }
1066     }
1067
1068     $ret->{modreqs_fully_documented} &&= !!$dbic_reqs->{$group}{pod}
1069       if $all_groups->{$group}{user_requested};
1070
1071     $ret->{release_testing_mandatory} ||= !!$dbic_reqs->{$group}{release_testing_mandatory};
1072   }
1073
1074   return $ret;
1075 }
1076
1077
1078 # this method tries to load specified modreqs and returns a hashref of
1079 # module/loaderror pairs for anything that failed
1080 sub _errorlist_for_modreqs {
1081   # args supposedly already went through _groups_to_reqs and are therefore sanitized
1082   # safe to eval at will
1083   my ($self, $reqs) = @_;
1084
1085   my $ret;
1086
1087   for my $m ( keys %$reqs ) {
1088     my $v = $reqs->{$m};
1089
1090     if (! exists $req_unavailability_cache{$m}{$v} ) {
1091       local $@;
1092       eval( "require $m;" . ( $v ? "$m->VERSION(q($v))" : '' ) );
1093       $req_unavailability_cache{$m}{$v} = $@;
1094     }
1095
1096     $ret->{$m} = $req_unavailability_cache{$m}{$v}
1097       if $req_unavailability_cache{$m}{$v};
1098   }
1099
1100   $ret;
1101 }
1102
1103
1104 # This is to be called by the author only (automatically in Makefile.PL)
1105 sub _gen_pod {
1106   my ($class, $distver, $pod_dir) = @_;
1107
1108   die "No POD root dir supplied" unless $pod_dir;
1109
1110   $distver ||=
1111     eval { require DBIx::Class; DBIx::Class->VERSION; }
1112       ||
1113     die
1114 "\n\n---------------------------------------------------------------------\n" .
1115 'Unable to load core DBIx::Class module to determine current version, '.
1116 'possibly due to missing dependencies. Author-mode autodocumentation ' .
1117 "halted\n\n" . $@ .
1118 "\n\n---------------------------------------------------------------------\n"
1119   ;
1120
1121   # do not ask for a recent version, use 1.x API calls
1122   # this *may* execute on a smoker with old perl or whatnot
1123   require File::Path;
1124
1125   (my $modfn = __PACKAGE__ . '.pm') =~ s|::|/|g;
1126
1127   (my $podfn = "$pod_dir/$modfn") =~ s/\.pm$/\.pod/;
1128   (my $dir = $podfn) =~ s|/[^/]+$||;
1129
1130   File::Path::mkpath([$dir]);
1131
1132   my $sqltver = $class->req_list_for('deploy')->{'SQL::Translator'}
1133     or die "Hrmm? No sqlt dep?";
1134
1135
1136   my @chunks;
1137
1138 #@@
1139 #@@ HEADER
1140 #@@
1141   push @chunks, <<"EOC";
1142 #########################################################################
1143 #####################  A U T O G E N E R A T E D ########################
1144 #########################################################################
1145 #
1146 # The contents of this POD file are auto-generated.  Any changes you make
1147 # will be lost. If you need to change the generated text edit _gen_pod()
1148 # at the end of $modfn
1149 #
1150
1151 =head1 NAME
1152
1153 $class - Optional module dependency specifications (for module authors)
1154 EOC
1155
1156
1157 #@@
1158 #@@ SYNOPSIS HEADING
1159 #@@
1160   push @chunks, <<"EOC";
1161 =head1 SYNOPSIS
1162
1163 Somewhere in your build-file (e.g. L<ExtUtils::MakeMaker>'s F<Makefile.PL>):
1164
1165   ...
1166
1167   \$EUMM_ARGS{CONFIGURE_REQUIRES} = {
1168     \%{ \$EUMM_ARGS{CONFIGURE_REQUIRES} || {} },
1169     'DBIx::Class' => '$distver',
1170   };
1171
1172   ...
1173
1174   my %DBIC_DEPLOY_AND_ORACLE_DEPS = %{ eval {
1175     require $class;
1176     $class->req_list_for([qw( deploy rdbms_oracle icdt )]);
1177   } || {} };
1178
1179   \$EUMM_ARGS{PREREQ_PM} = {
1180     \%DBIC_DEPLOY_AND_ORACLE_DEPS,
1181     \%{ \$EUMM_ARGS{PREREQ_PM} || {} },
1182   };
1183
1184   ...
1185
1186   ExtUtils::MakeMaker::WriteMakefile(\%EUMM_ARGS);
1187
1188 B<Note>: The C<eval> protection within the example is due to support for
1189 requirements during L<the C<configure> build phase|CPAN::Meta::Spec/Phases>
1190 not being available on a sufficient portion of production installations of
1191 Perl. Robust support for such dependency requirements is available in the
1192 L<CPAN> installer only since version C<1.94_56> first made available for
1193 production with perl version C<5.12>. It is the belief of the current
1194 maintainer that support for requirements during the C<configure> build phase
1195 will not be sufficiently ubiquitous until the B<year 2020> at the earliest,
1196 hence the extra care demonstrated above. It should also be noted that some
1197 3rd party installers (e.g. L<cpanminus|App::cpanminus>) do the right thing
1198 with configure requirements independent from the versions of perl and CPAN
1199 available.
1200 EOC
1201
1202
1203 #@@
1204 #@@ DESCRIPTION HEADING
1205 #@@
1206   push @chunks, <<'EOC';
1207 =head1 DESCRIPTION
1208
1209 Some of the less-frequently used features of L<DBIx::Class> have external
1210 module dependencies on their own. In order not to burden the average user
1211 with modules they will never use, these optional dependencies are not included
1212 in the base Makefile.PL. Instead an exception with a descriptive message is
1213 thrown when a specific feature can't find one or several modules required for
1214 its operation. This module is the central holding place for the current list
1215 of such dependencies, for DBIx::Class core authors, and DBIx::Class extension
1216 authors alike.
1217
1218 Dependencies are organized in L<groups|/CURRENT REQUIREMENT GROUPS> where each
1219 group can list one or more required modules, with an optional minimum version
1220 (or 0 for any version). In addition groups prefixed with C<test_> can specify
1221 a set of environment variables, some (or all) of which are marked as required
1222 for the group to be considered by L</req_list_for>
1223
1224 Each group name (or a combination thereof) can be used in the
1225 L<public methods|/METHODS> as described below.
1226 EOC
1227
1228
1229 #@@
1230 #@@ REQUIREMENT GROUPLIST HEADING
1231 #@@
1232   push @chunks, '=head1 CURRENT REQUIREMENT GROUPS';
1233
1234   my $standalone_info;
1235
1236   for my $group (sort keys %$dbic_reqs) {
1237
1238     my $info = $standalone_info->{$group} ||= $class->_groups_to_reqs($group);
1239
1240     next unless (
1241       $info->{modreqs_fully_documented}
1242         and
1243       ( $info->{augments} or $info->{modreqs} )
1244     );
1245
1246     my $p = $dbic_reqs->{$group}{pod};
1247
1248     push @chunks, (
1249       "=head2 $p->{title}",
1250       "=head3 $group",
1251       $p->{desc},
1252       '=over',
1253     );
1254
1255     if ( keys %{ $info->{modreqs}||{} } ) {
1256       push @chunks, map
1257         { "=item * $_" . ($info->{modreqs}{$_} ? " >= $info->{modreqs}{$_}" : '') }
1258         ( sort keys %{ $info->{modreqs} } )
1259       ;
1260     }
1261     else {
1262       push @chunks, '=item * No standalone requirements',
1263     }
1264
1265     push @chunks, '=back';
1266
1267     for my $ag ( sort keys %{ $info->{augments} || {} } ) {
1268       my $ag_info = $standalone_info->{$ag} ||= $class->_groups_to_reqs($ag);
1269
1270       my $newreqs = $class->modreq_list_for([ $group, $ag ]);
1271       for (keys %$newreqs) {
1272         delete $newreqs->{$_} if (
1273           ( defined $info->{modreqs}{$_}    and $info->{modreqs}{$_}    == $newreqs->{$_} )
1274             or
1275           ( defined $ag_info->{modreqs}{$_} and $ag_info->{modreqs}{$_} == $newreqs->{$_} )
1276         );
1277       }
1278
1279       if (keys %$newreqs) {
1280         push @chunks, (
1281           "Combined with L</$ag> additionally requires:",
1282           '=over',
1283           ( map
1284             { "=item * $_" . ($newreqs->{$_} ? " >= $newreqs->{$_}" : '') }
1285             ( sort keys %$newreqs )
1286           ),
1287           '=back',
1288         );
1289       }
1290     }
1291   }
1292
1293
1294 #@@
1295 #@@ API DOCUMENTATION HEADING
1296 #@@
1297   push @chunks, <<'EOC';
1298
1299 =head1 IMPORT-LIKE ACTIONS
1300
1301 Even though this module is not an L<Exporter>, it recognizes several C<actions>
1302 supplied to its C<import> method.
1303
1304 =head2 -skip_all_without
1305
1306 =over
1307
1308 =item Arguments: @group_names
1309
1310 =back
1311
1312 A convenience wrapper for use during testing:
1313 EOC
1314
1315   push @chunks, " use $class -skip_all_without => qw(admin test_rdbms_mysql);";
1316
1317   push @chunks, 'Roughly equivalent to the following code:';
1318
1319   push @chunks, sprintf <<'EOS', ($class) x 2;
1320
1321  BEGIN {
1322    require %s;
1323    if ( my $missing = %s->req_missing_for(\@group_names_) ) {
1324      print "1..0 # SKIP requirements not satisfied: $missing\n";
1325      exit 0;
1326    }
1327  }
1328 EOS
1329
1330   push @chunks, <<'EOC';
1331
1332 It also takes into account the C<RELEASE_TESTING> environment variable and
1333 behaves like L</-die_without> for any requirement groups marked as
1334 C<release_testing_mandatory>.
1335
1336 =head2 -die_without
1337
1338 =over
1339
1340 =item Arguments: @group_names
1341
1342 =back
1343
1344 A convenience wrapper around L</die_unless_req_ok_for>:
1345 EOC
1346
1347   push @chunks, " use $class -die_without => qw(deploy admin);";
1348
1349   push @chunks, <<'EOC';
1350
1351 =head2 -list_missing
1352
1353 =over
1354
1355 =item Arguments: @group_names
1356
1357 =back
1358
1359 A convenience wrapper around L</modreq_missing_for>:
1360
1361  perl -Ilib -MDBIx::Class::Optional::Dependencies=-list_missing,deploy,admin | cpanm
1362
1363 =head1 METHODS
1364
1365 =head2 req_group_list
1366
1367 =over
1368
1369 =item Arguments: none
1370
1371 =item Return Value: \%list_of_requirement_groups
1372
1373 =back
1374
1375 This method should be used by DBIx::Class packagers, to get a hashref of all
1376 dependencies B<keyed> by dependency group. Each key (group name), or a combination
1377 thereof (as an arrayref) can be supplied to the methods below.
1378 The B<values> of the returned hash are currently a set of options B<without a
1379 well defined structure>. If you have use for any of the contents - contact the
1380 maintainers, instead of treating this as public (left alone stable) API.
1381
1382 =head2 req_list_for
1383
1384 =over
1385
1386 =item Arguments: $group_name | \@group_names
1387
1388 =item Return Value: \%set_of_module_version_pairs
1389
1390 =back
1391
1392 This method should be used by DBIx::Class extension authors, to determine the
1393 version of modules a specific set of features requires for this version of
1394 DBIx::Class (regardless of their availability on the system).
1395 See the L</SYNOPSIS> for a real-world example.
1396
1397 When handling C<test_*> groups this method behaves B<differently> from
1398 L</modreq_list_for> below (and is the only such inconsistency among the
1399 C<req_*> methods). If a particular group declares as requirements some
1400 C<environment variables> and these requirements are not satisfied (the envvars
1401 are unset) - then the C<module requirements> of this group are not included in
1402 the returned list.
1403
1404 =head2 modreq_list_for
1405
1406 =over
1407
1408 =item Arguments: $group_name | \@group_names
1409
1410 =item Return Value: \%set_of_module_version_pairs
1411
1412 =back
1413
1414 Same as L</req_list_for> but does not take into consideration any
1415 C<environment variable requirements> - returns just the list of required
1416 modules.
1417
1418 =head2 req_ok_for
1419
1420 =over
1421
1422 =item Arguments: $group_name | \@group_names
1423
1424 =item Return Value: 1|0
1425
1426 =back
1427
1428 Returns true or false depending on whether all modules/envvars required by
1429 the group(s) are loadable/set on the system.
1430
1431 =head2 req_missing_for
1432
1433 =over
1434
1435 =item Arguments: $group_name | \@group_names
1436
1437 =item Return Value: $error_message_string
1438
1439 =back
1440
1441 Returns a single-line string suitable for inclusion in larger error messages.
1442 This method would normally be used by DBIx::Class core features, to indicate to
1443 the user that they need to install specific modules and/or set specific
1444 environment variables before being able to use a specific feature set.
1445
1446 For example if some of the requirements for C<deploy> are not available,
1447 the returned string could look like:
1448 EOC
1449
1450   push @chunks, qq{ "SQL::Translator~>=$sqltver" (see $class documentation for details)};
1451
1452   push @chunks, <<'EOC';
1453 The author is expected to prepend the necessary text to this message before
1454 returning the actual error seen by the user. See also L</modreq_missing_for>
1455
1456 =head2 modreq_missing_for
1457
1458 =over
1459
1460 =item Arguments: $group_name | \@group_names
1461
1462 =item Return Value: $error_message_string
1463
1464 =back
1465
1466 Same as L</req_missing_for> except that the error string is guaranteed to be
1467 either empty, or contain a set of module requirement specifications suitable
1468 for piping to e.g. L<cpanminus|App::cpanminus>. The method explicitly does not
1469 attempt to validate the state of required environment variables (if any).
1470
1471 For instance if some of the requirements for C<deploy> are not available,
1472 the returned string could look like:
1473 EOC
1474
1475   push @chunks, qq{ "SQL::Translator~>=$sqltver"};
1476
1477   push @chunks, <<'EOC';
1478
1479 See also L</-list_missing>.
1480
1481 =head2 skip_without
1482
1483 =over
1484
1485 =item Arguments: $group_name | \@group_names
1486
1487 =back
1488
1489 A convenience wrapper around L<skip|Test::More/SKIP>. It does not take neither
1490 a reason (it is generated by L</req_missing_for>) nor an amount of skipped tests
1491 (it is always C<1>, thus mandating unconditional use of
1492 L<done_testing|Test::More/done_testing>). Most useful in combination with ad hoc
1493 requirement specifications:
1494 EOC
1495
1496   push @chunks, <<EOC;
1497   SKIP: {
1498     $class->skip_without([ deploy YAML>=0.90 ]);
1499
1500     ...
1501   }
1502 EOC
1503
1504   push @chunks, <<'EOC';
1505
1506 =head2 die_unless_req_ok_for
1507
1508 =over
1509
1510 =item Arguments: $group_name | \@group_names
1511
1512 =back
1513
1514 Checks if L</req_ok_for> passes for the supplied group(s), and
1515 in case of failure throws an exception including the information
1516 from L</req_missing_for>. See also L</-die_without>.
1517
1518 =head2 modreq_errorlist_for
1519
1520 =over
1521
1522 =item Arguments: $group_name | \@group_names
1523
1524 =item Return Value: \%set_of_loaderrors_per_module
1525
1526 =back
1527
1528 Returns a hashref containing the actual errors that occurred while attempting
1529 to load each module in the requirement group(s).
1530
1531 =head2 req_errorlist_for
1532
1533 Deprecated method name, equivalent (via proxy) to L</modreq_errorlist_for>.
1534
1535 EOC
1536
1537 #@@
1538 #@@ FOOTER
1539 #@@
1540   push @chunks, <<'EOC';
1541 =head1 FURTHER QUESTIONS?
1542
1543 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
1544
1545 =head1 COPYRIGHT AND LICENSE
1546
1547 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
1548 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
1549 redistribute it and/or modify it under the same terms as the
1550 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
1551 EOC
1552
1553   eval {
1554     open (my $fh, '>', $podfn) or die;
1555     print $fh join ("\n\n", @chunks) or die;
1556     print $fh "\n" or die;
1557     close ($fh) or die;
1558   } or croak( "Unable to write $podfn: " . ( $! || $@ || 'unknown error') );
1559 }
1560
1561 1;