Changeset 30946

Show
Ignore:
Timestamp:
03/08/09 16:55:05 (4 years ago)
Author:
charsbar
Message:

Path-Extended: fixed unstable compat test; better pod coverage; better subsclassing; added "basename" to dir; close before rmdir, and after children; 0.10 -> CPAN

Location:
lang/perl/Path-Extended/trunk
Files:
11 added
10 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/Path-Extended/trunk/Changes

    r30885 r30946  
    11Revision history for Path-Extended 
     2 
     30.10 2009/03/08 
     4  - fixed a compatibility test which may break under some environment 
     5  - better pod coverage 
     6  - reorganized a bit and added "basename" to dir (cf. RT #17312) 
     7  - better subclassing 
     8  - forgot to close a directory after ->children, and before ->rmdir 
    29 
    3100.09 2009/03/06 

  • lang/perl/Path-Extended/trunk/MANIFEST

    r30767 r30946  
    1515t/30_directory.t 
    1616t/40_compatibility.t 
     17t/50_subclass.t 
    1718t/99_pod.t 
    1819t/99_podcoverage.t 
     20t/lib/Path/Extended/Test.pm 
    1921t/lib/Path/Extended/Test/Compatibility/Basic.pm 
    2022t/lib/Path/Extended/Test/Compatibility/Filesystem.pm 
     23t/lib/Path/Extended/Test/Dir.pm 
    2124t/lib/Path/Extended/Test/Dir/Copy.pm 
    2225t/lib/Path/Extended/Test/Dir/Exists.pm 
    … …  
    2730t/lib/Path/Extended/Test/Dir/Seek.pm 
    2831t/lib/Path/Extended/Test/Entity/Log.pm 
     32t/lib/Path/Extended/Test/File.pm 
    2933t/lib/Path/Extended/Test/File/Copy.pm 
    3034t/lib/Path/Extended/Test/File/Grep.pm 
    … …  
    3438t/lib/Path/Extended/Test/File/Slurp.pm 
    3539t/lib/Path/Extended/Test/File/Stat.pm 
     40t/lib/Path/Extended/Test/Subclass/Dir.pm 
     41t/lib/Path/Extended/Test/Subclass/File.pm 
     42t/lib/Path/Extended/Test/Subclass/Import.pm 

  • lang/perl/Path-Extended/trunk/Makefile.PL

    r30767 r30946  
    1212    'Carp'                  => 0, 
    1313    'Encode'                => 0, 
    14     'Exporter::Lite'        => 0, 
    1514    'Fcntl'                 => 0, 
    1615    'File::Basename'        => 0, 
    … …  
    2322    'Log::Dump'             => 0, 
    2423    'Scalar::Util'          => 0, 
     24    'Sub::Install'          => 0, 
    2525    'Test::Classy'          => '0.04', 
    2626    'Test::More'            => '0.47', 

  • lang/perl/Path-Extended/trunk/lib/Path/Extended.pm

    r30885 r30946  
    33use strict; 
    44use warnings; 
    5 use base qw( Exporter::Lite ); 
    6 use Path::Extended::File; 
    7 use Path::Extended::Dir; 
     5use Sub::Install; 
    86 
    9 our $VERSION = '0.09'; 
     7our $VERSION = '0.10'; 
    108 
    11 our @EXPORT = our @EXPORT_OK = qw( file dir ); 
     9sub import { 
     10  my ($class, @imports) = @_; 
    1211 
    13 sub file { Path::Extended::File->new( @_ ) } 
    14 sub dir  { Path::Extended::Dir->new( @_ ) } 
     12  my $caller = caller; 
     13 
     14  @imports = qw( file dir ) unless @imports; 
     15  foreach my $import (@imports) { 
     16    next unless $import =~ /^(?:file|dir)$/; 
     17    my $target = $class.'::'.ucfirst($import); 
     18    eval "require $target" or die $@; 
     19    Sub::Install::install_sub({ 
     20      as   => $import, 
     21      into => $caller, 
     22      code => sub { $target->new(@_) }, 
     23    }); 
     24    Sub::Install::reinstall_sub({ 
     25      as   => $import, 
     26      into => $class, 
     27      code => sub { $target->new(@_) }, 
     28    }); 
     29  } 
     30} 
    1531 
    16321; 

  • lang/perl/Path-Extended/trunk/lib/Path/Extended/Class.pm

    r30767 r30946  
    33use strict; 
    44use warnings; 
    5 use base qw( Exporter::Lite ); 
    6 use Path::Extended::Class::File; 
    7 use Path::Extended::Class::Dir; 
    8  
    9 our @EXPORT = our @EXPORT_OK = qw( file dir ); 
    10  
    11 sub file { Path::Extended::Class::File->new( @_ ) } 
    12 sub dir  { Path::Extended::Class::Dir->new( @_ ) } 
     5use base qw( Path::Extended ); 
    136 
    1471; 
    … …  
    2821=head1 DESCRIPTION 
    2922 
    30 If you want some functionality of L<Path::Extended> but also want more L<Path::Class>-compatible API, try L<Path::Extended::Class>, which is built upon L<Path::Extended> and passes many of the L<Path::Class> tests. What you may miss are foreign expressions, C<recurse> method for a directory, and C<absolute>/C<relative> chains (those of L<Path::Extended::Class> return a string instead of an object). 
     23If you want some functionality of L<Path::Extended> but also want more L<Path::Class>-compatible API, try L<Path::Extended::Class>, which is built upon L<Path::Extended> and passes many of the L<Path::Class> tests. What you may miss are foreign expressions, and C<absolute>/C<relative> chains (those of L<Path::Extended::Class> return a string instead of an object). 
    3124 
    3225=head1 FUNCTIONS 

  • lang/perl/Path-Extended/trunk/lib/Path/Extended/Class/Dir.pm

    r30855 r30946  
    2626sub as_foreign { shift } # does nothing 
    2727 
    28 sub file   { shift->_related( file => @_ ); } 
    29 sub subdir { shift->_related( dir  => @_ ); } 
    30  
    3128sub dir_list { 
    3229  my $self = shift; 
    … …  
    4542} 
    4643 
    47 sub _parts { 
    48   my ($self, $abs) = @_; 
    49  
    50   my $path = $abs ? $self->absolute : $self->_path; 
    51   my ($vol, $dir, $file) = File::Spec->splitpath( $path ); 
    52   return split '/', "$dir$file"; 
    53 } 
    54  
    5544sub volume { 
    5645  my $self = shift; 
    … …  
    6453 
    6554  Carp::croak "No second entity given to subsumes()" unless $other; 
    66   $other = __PACKAGE__->new($other) unless UNIVERSAL::isa($other, __PACKAGE__); 
     55  my $class = $self->_class('dir'); 
     56  $other = $class->new($other) unless UNIVERSAL::isa($other, $class); 
    6757  $other = $other->dir unless $other->is_dir; 
    6858 
    … …  
    10292 
    10393=head1 COMPATIBLE METHODS 
    104  
    105 =head2 file, subdir 
    106  
    107 returns a child L<Path::Extended::Class::File>/L<Path::Extended::Class::Dir> object in the directory. See L<Path::Class::Dir> for details. 
    10894 
    10995=head2 volume 

  • lang/perl/Path-Extended/trunk/lib/Path/Extended/Dir.pm

    r30855 r30946  
    2727} 
    2828 
     29sub _parts { 
     30  my ($self, $abs) = @_; 
     31 
     32  my $path = $abs ? $self->absolute : $self->_path; 
     33  my ($vol, $dir, $file) = File::Spec->splitpath( $path ); 
     34  return split '/', "$dir$file"; 
     35} 
     36 
     37sub basename { 
     38  my $self = shift; 
     39 
     40  return ($self->_parts)[-1]; 
     41} 
     42 
    2943sub open { 
    3044  my $self = shift; 
    … …  
    118132sub rmdir { 
    119133  my $self = shift; 
     134 
     135  $self->close if $self->is_open; 
    120136 
    121137  if ( $self->exists ) { 
    … …  
    158174  } 
    159175} 
     176 
     177sub file   { shift->_related( file => @_ ); } 
     178sub subdir { shift->_related( dir  => @_ ); } 
    160179 
    161180sub children { 
    … …  
    171190    push @children, $self->_related( $type => $entry ); 
    172191  } 
     192  $self->close; 
    173193  return @children; 
    174194} 
    … …  
    243263takes a path or parts of a path of a directory (or a file in the case of C<new_from_file>), and creates a L<Path::Extended::Dir> object. If the path specified is a relative one, it will be converted to the absolute one internally.  
    244264 
     265=head2 basename 
     266 
     267returns the last part of the directory. 
     268 
    245269=head2 open, close, read, seek, tell, rewind 
    246270 
    … …  
    275299  } 
    276300 
    277 returns a L<Path::Extended::Dir> or L<Path::Extended::File> object to iterate through directory contents (or C<undef> when there's no more items in the directory). The directory will be open with the first C<next>, and close with the last C<next>. 
     301returns a L<Path::Extended::Dir> or L<Path::Extended::File> object while iterating through the directory (or C<undef> when there's no more items there). The directory will be open with the first C<next>, and close with the last C<next>. 
    278302 
    279303=head2 children 
    280304 
    281305returns a list of L<Path::Extended::Class::File> and/or L<Path::Extended::Class::Dir> objects listed in the directory. See L<Path::Class::Dir> for details. 
     306 
     307=head2 file, subdir 
     308 
     309returns a child L<Path::Extended::Class::File>/L<Path::Extended::Class::Dir> object in the directory. 
     310 
     311=head2 recurse 
     312 
     313  dir('path/to/somewhere')->recurse( callback => sub { 
     314    my $file_or_dir = shift; 
     315    ... 
     316  }); 
     317 
     318takes a hash and iterates through the directory and all its subdirectories recursively, and call the callback function for each entry. Options are: 
     319 
     320=over 4 
     321 
     322=item callback 
     323 
     324a code reference to call for each entry. 
     325 
     326=item depthfirst, preorder 
     327 
     328flags to change the order of processing. 
     329 
     330=back 
    282331 
    283332=head1 AUTHOR 

  • lang/perl/Path-Extended/trunk/lib/Path/Extended/Entity.pm

    r30866 r30946  
    2424sub _initialize {} 
    2525 
     26sub _class { 
     27  my ($self, $type) = @_; 
     28  my $class = ref $self; 
     29  $class =~ s/::(?:File|Dir|Entity)$//; 
     30  return $class unless $type; 
     31  return $class.'::'.($type eq 'file' ? 'File' : 'Dir'); 
     32} 
     33 
    2634sub _related { 
    2735  my ($self, $type, @parts) = @_; 
    2836 
    29   my $class = 'Path::Extended::'; 
    30   $class .= 'Class::' if $self->{_compat}; 
    31   $class .= $type eq 'file' ? 'File' : 'Dir'; 
     37  my $class = $self->_class($type); 
    3238  eval "require $class" or Carp::croak $@; 
    3339  my $item; 
    … …  
    4854} 
    4955 
     56sub _unixify { 
     57  my ($self, $path) = @_; 
     58 
     59  $path =~ s{\\}{/}g if $^O eq 'MSWin32'; 
     60 
     61  return $path; 
     62} 
     63 
    5064sub _handle { shift->{handle} } 
    5165 
    … …  
    166180} 
    167181 
    168 sub _unixify { 
    169   my ($self, $path) = @_; 
    170  
    171   $path =~ s{\\}{/}g if $^O eq 'MSWin32'; 
    172  
    173   return $path; 
    174 } 
    175  
    176182sub stat { 
    177183  my $self = shift; 

  • lang/perl/Path-Extended/trunk/t/lib/Path/Extended/Test/Compatibility/Basic.pm

    r30767 r30946  
    3030} 
    3131 
    32 sub test02_dir1 : Tests(6) { 
     32sub test02_dir1 : Tests(7) { 
    3333  my $class = shift; 
    3434 
    … …  
    3636  ok $dir eq 'tmp', $class->message("test 10"); 
    3737  ok !$dir->is_absolute, $class->message("test 11"); 
     38  ok $dir->basename eq 'tmp', $class->message("RT 17312"); 
    3839 
    3940  my $cat = file($dir, 'foo'); 
    … …  
    4546} 
    4647 
    47 sub test03_dir2 : Tests(8) { 
     48sub test03_dir2 : Tests(9) { 
    4849  my $class = shift; 
    4950 
    … …  
    6263  ok $cat eq '/tmp/foo', $class->message("test 22"); 
    6364  ok $cat->isa('Path::Extended::Class::Dir'), $class->message("test 23"); 
     65  ok $cat->basename eq 'foo', $class->message("RT 17312"); 
    6466} 
    6567 
    … …  
    120122  my $dir = dir('one/two/three/four/five'); 
    121123  my @d = $dir->dir_list(); 
    122   ok "@d" eq "one two three four five", $class->message("test 47"."@d"); 
     124  ok "@d" eq "one two three four five", $class->message("test 47"); 
    123125 
    124126  @d = $dir->dir_list(2); 

  • lang/perl/Path-Extended/trunk/t/lib/Path/Extended/Test/Compatibility/Filesystem.pm

    r30855 r30946  
    160160 
    161161  my $d = dir('a'); 
    162   my @children = $d->children; 
     162  my @children = sort $d->children; # following test breaks sometimes 
    163163 
    164164  is_deeply \@children, ['a/b', 'a/c'];