Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

* Add ignore_source_control option

  • Loading branch information...
commit 6cc882cc09b2987ce0f3a4f8087ea751feaa88f1 1 parent 336a9e0
brian d foy authored February 19, 2010
4  Makefile.PL
@@ -16,11 +16,11 @@ requires('File::Path'     => '2.04'); # new interface, bugfixes
16 16
 requires('File::HomeDir'  => '0.57'); # Win32 Support
17 17
 requires('Pod::Usage'     => '1.00');
18 18
 
19  
-extra_tests;
  19
+extra_tests();
20 20
 
21 21
 install_script('bin/minicpan');
22 22
 
23 23
 repository('http://github.com/rjbs/cpan-mini');
24  
-auto_manifest;
  24
+auto_manifest();
25 25
 
26 26
 WriteAll();
2  bin/minicpan
@@ -44,6 +44,8 @@ example:
44 44
  remote: http://your.favorite.cpan/cpan/
45 45
  exact_mirror: 1
46 46
 
  47
+See C<CPAN::Mini> for a full listing of available options.
  48
+
47 49
 =head1 TO DO
48 50
 
49 51
 Improve command-line options.
130  lib/CPAN/Mini.pm
@@ -96,6 +96,11 @@ directories.  It defaults to 0711.
96 96
 
97 97
 If true, the C<files_allowed> method will allow all extra files to be mirrored.
98 98
 
  99
+=item * C<ignore_source_control>
  100
+
  101
+If true, CPAN::Mini will not try to remove source control files during
  102
+cleanup. See C<clean_unmirrored> for details.
  103
+
99 104
 =item * C<force>
100 105
 
101 106
 If true, this option will cause CPAN::Mini to read the entire module list and
@@ -166,6 +171,10 @@ sub update_mirror {
166 171
   $self = $self->new(@_) unless ref $self;
167 172
 
168 173
   unless ($self->{offline}) {
  174
+    $self->trace( "Updating $self->{local}\n" );
  175
+    $self->trace( "Mirroring from $self->{remote}\n" );
  176
+    $self->trace( "=" x 63 . "\n" );
  177
+    
169 178
     # mirrored tracks the already done, keyed by filename
170 179
     # 1 = local-checked, 2 = remote-mirrored
171 180
     $self->mirror_indices;
@@ -513,7 +522,7 @@ all files are allowed.
513 522
 
514 523
 sub file_allowed {
515 524
   my ($self, $file) = @_;
516  
-  return if $self->{exact_mirror};
  525
+  return 1 if $self->{exact_mirror};
517 526
 
518 527
   # It's a cheap hack, but it gets the job done.
519 528
   return 1 if $file eq File::Spec->catfile($self->{local}, 'RECENT');
@@ -527,15 +536,34 @@ sub file_allowed {
527 536
 
528 537
 This method looks through the local mirror's files.  If it finds a file that
529 538
 neither belongs in the mirror nor is allowed (see the C<file_allowed> method),
530  
-C<clean_file> is called on the file.
  539
+C<clean_file> is called on the file. 
  540
+
  541
+If you set C<ignore_source_control> to a true value, then this doesn't clean
  542
+up files that belong to source control systems. Currently this ignores:
  543
+
  544
+	.cvs .cvsignore
  545
+	.svn .svnignore
  546
+	.git .gitignore
  547
+
  548
+Send patches for other source control files that you
531 549
 
532 550
 =cut
533 551
 
  552
+BEGIN {
  553
+my %Source_control_files = 
  554
+	map { $_, 1 }
  555
+	qw(.cvs .svn .git .cvsignore .svnignore .gitignore);
  556
+
534 557
 sub clean_unmirrored {
535 558
   my $self = shift;
536 559
 
537 560
   File::Find::find sub {
538 561
     my $file = File::Spec->canonpath($File::Find::name);  ## no critic Package
  562
+    my $basename = basename( $file );
  563
+    if( $self->{ignore_source_control} and exists $Source_control_files{$basename} ) {
  564
+      $File::Find::prune = 1;
  565
+      return;
  566
+      }
539 567
     return unless (-f $file and not $self->{mirrored}{$file});
540 568
     return if $self->file_allowed($file);
541 569
     $self->trace("cleaning $file ...");
@@ -547,6 +575,7 @@ sub clean_unmirrored {
547 575
   }, $self->{local};
548 576
 }
549 577
 
  578
+}
550 579
 =head2 clean_file
551 580
 
552 581
   $minicpan->clean_file($filename);
@@ -578,7 +607,7 @@ it.
578 607
 
579 608
 sub trace {
580 609
   my ($self, $message) = @_;
581  
-  print $message if $self->{trace};
  610
+  print { $self->_trace_fh } $message;
582 611
 }
583 612
 
584 613
 =head2 read_config
@@ -603,6 +632,11 @@ sub __homedir {
603 632
   return $homedir;
604 633
 }
605 634
 
  635
+sub __homedir_configfile {
  636
+  my ($class) = @_;
  637
+  my $default = File::Spec->catfile($class->__homedir, '.minicpanrc');
  638
+  }
  639
+  
606 640
 sub __default_configfile {
607 641
   my ($self) = @_;
608 642
 
@@ -611,18 +645,16 @@ sub __default_configfile {
611 645
 }
612 646
 
613 647
 sub read_config {
614  
-  my ($class) = @_;
615  
-
616  
-  my $filename = File::Spec->catfile($class->__homedir, '.minicpanrc');
617  
-
618  
-  $filename = $class->__default_configfile unless -e $filename;
619  
-  return unless -e $filename;
  648
+  my ($class, $options) = @_;
620 649
 
621  
-  open my $config_file, '<', $filename
622  
-    or die "couldn't open config file $filename: $!";
  650
+  my $config_file = $class->config_file( $options );
  651
+  $class->trace( "Using config from $config_file\n" );
  652
+  
  653
+  open my $config_fh, '<', $config_file
  654
+    or die "couldn't open config file $config_file: $!";
623 655
 
624 656
   my %config;
625  
-  while (<$config_file>) {
  657
+  while (<$config_fh>) {
626 658
     chomp;
627 659
     next if /\A\s*\Z/sm;
628 660
     if (/\A(\w+):\s*(\S.*?)\s*\Z/sm) { $config{$1} = $2; }
@@ -639,6 +671,80 @@ sub read_config {
639 671
   return %config;
640 672
 }
641 673
 
  674
+=head2 config_file( OPTIONS )
  675
+
  676
+  my %config = CPAN::Mini->config_file( { options } );
  677
+
  678
+This routine returns the config file name. It first looks at for the
  679
+C<config_file> setting, then the C<CPAN_MINI_CONFIG> environment
  680
+variable, then the default F<~/.minicpanrc>, and finally the
  681
+F<CPAN/Mini/minicpan.conf>. It uses the first defined value it finds.
  682
+If the filename it selects does not exist, it returns the empty list.
  683
+
  684
+OPTIONS is an optional hash reference of the C<CPAN::Mini> config hash. 
  685
+
  686
+=cut
  687
+
  688
+sub config_file {
  689
+  my ($class, $options) = @_;
  690
+  	
  691
+  my $config_file = do {
  692
+    if( defined eval { $options->{config_file} } ) {
  693
+  	  $options->{config_file};
  694
+	  }
  695
+    elsif( defined $ENV{CPAN_MINI_CONFIG} ) {
  696
+	  $ENV{CPAN_MINI_CONFIG};
  697
+	  }
  698
+	elsif( defined $class->__homedir_configfile ) {
  699
+	  $class->__homedir_configfile;
  700
+	  }
  701
+	elsif( defined $class->__default_configfile ) {
  702
+	  $class->__default_configfile;
  703
+      }
  704
+    else {
  705
+      ()
  706
+      }
  707
+    };
  708
+     
  709
+  return(
  710
+   (defined $config_file && -e $config_file)
  711
+     ? 
  712
+   $config_file 
  713
+     : 
  714
+   ()
  715
+   );
  716
+  }
  717
+
  718
+sub __default_fh { *STDOUT{IO} }
  719
+
  720
+# stolen from IO::Interactive
  721
+local (*DEV_NULL, *DEV_NULL2);
  722
+my $dev_null;
  723
+BEGIN {
  724
+    pipe *DEV_NULL, *DEV_NULL2
  725
+        or die "Internal error: can't create null filehandle";
  726
+    $dev_null = \*DEV_NULL;
  727
+}
  728
+
  729
+sub __quiet_fh { $dev_null }
  730
+  
  731
+sub _trace_fh {
  732
+  my ($either) = @_;
  733
+  
  734
+  return do {
  735
+    if( ref $either and defined $either->{trace} and ! $either->{trace} ) {
  736
+      $either->__quiet_fh;
  737
+      }
  738
+    elsif( eval { $either->can( '_default_fh' ) } ) {
  739
+      $either->__default_fh;
  740
+      }
  741
+    else {
  742
+      __default_fh();
  743
+      }
  744
+    };
  745
+
  746
+  }
  747
+	
642 748
 =head2 
643 749
 
644 750
 =head1 SEE ALSO
31  lib/CPAN/Mini/App.pm
@@ -52,10 +52,10 @@ sub run {
52 52
     "d|dirmode=s" => \$config{dirmode},
53 53
     "qq"          => sub { $config{quiet} = 2; $config{errors} = 0; },
54 54
     'offline'     => \$config{offline},
55  
-    "q+" => \$config{quiet},
56  
-    "f+" => \$config{force},
57  
-    "p+" => \$config{perl},
58  
-    "x+" => \$config{exact_mirror},
  55
+    "q+"          => \$config{quiet},
  56
+    "f+"          => \$config{force},
  57
+    "p+"          => \$config{perl},
  58
+    "x+"          => \$config{exact_mirror},
59 59
   ) or pod2usage(2);
60 60
 
61 61
   eval "require $config{class}";
@@ -68,17 +68,18 @@ sub run {
68 68
   $config{dirmode} &&= oct($config{dirmode});
69 69
 
70 70
   $config{class}->update_mirror(
71  
-    remote  => $config{remote},
72  
-    local   => $config{local},
73  
-    trace   => (not $config{quiet}),
74  
-    force   => $config{force},
75  
-    offline => $config{offline},
76  
-    also_mirror    => $config{also_mirror},
77  
-    exact_mirror   => $config{exact_mirror},
78  
-    module_filters => $config{module_filters},
79  
-    path_filters   => $config{path_filters},
80  
-    skip_cleanup   => $config{skip_cleanup},
81  
-    skip_perl      => (not $config{perl}),
  71
+    remote                => $config{remote},
  72
+    local                 => $config{local},
  73
+    trace                 => (not $config{quiet}),
  74
+    force                 => $config{force},
  75
+    offline               => $config{offline},
  76
+    also_mirror           => $config{also_mirror},
  77
+    exact_mirror          => $config{exact_mirror},
  78
+    ignore_source_control => $config{ignore_source_control}
  79
+    module_filters        => $config{module_filters},
  80
+    path_filters          => $config{path_filters},
  81
+    skip_cleanup          => $config{skip_cleanup},
  82
+    skip_perl             => (not $config{perl}),
82 83
     (defined $config{dirmode} ? (dirmode => $config{dirmode}) : ()),
83 84
     (defined $config{errors}  ? (errors  => $config{errors})  : ()),
84 85
   );

0 notes on commit 6cc882c

Please sign in to comment.
Something went wrong with that request. Please try again.