pfile #5

  • //
  • guest/
  • barrie_slaymaker/
  • safari/
  • src/
  • conf/
  • bin/
  • pfile
  • View
  • Commits
  • Open Download .zip Download (2 KB)
#!/usr/bin/perl -w

#
# pfile for Safari
# Copyright (c) 1999 by Barrie Slaymaker, rbs@telerama.com
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the README file.
#

use strict ;

use Getopt::Long ;
use File::Type qw( add_mime_types get_type type_2_mime ) ;

my %options ;

GetOptions(
   \%options,
   'debug|d+',
   'types|type=s@',
   'tests|tests=i@',
   'mime-file=s',
   'fields=s',
   'follow!',
) ;

if ( defined( $options{'mime-file'} ) ) {
   add_mime_types( $options{'mime-file'} ) ;
}

my $max_name_length = 0 ;
my $max_type_length = 0 ;
my %types ;

@ARGV = ( '-' ) unless @ARGV ;

for ( @ARGV ) {
   if ( $_ eq '-' ) {
      $/ = undef ;
      $_ = 'stdin' ;
      $types{$_} = get_type( \%options, undef, <STDIN> ) ;
   }
   else {
      $types{$_} = get_type( \%options, $_ ) ;
   }
   $max_name_length = length( $_ )
      if length( $_ ) > $max_name_length ;
   $max_type_length = length( $types{$_} )
      if length( $types{$_} ) > $max_type_length ;
}

my $print_file = 1 ;
my $print_type = 1 ;
my $print_mime = 1 ;

if ( defined( $options{'fields'} ) ) {
   for ( $options{'fields'} ) {
      $print_file = m/\bfile\b/ ;
      $print_type = m/\btype\b/ ;
      $print_mime = m/\bmime\b/ ;
   }
}

++$max_name_length ;
for ( sort keys %types ) {
   my $type = $types{$_} ;
   my $mime_type = type_2_mime( $type ) ;
   my @output ;
   push( @output, sprintf( "%-${max_name_length}s", "$_:" ) ) if $print_file ;
   push( @output, sprintf( "%-${max_type_length}s", $type ) ) if $print_type ;
   push( @output, sprintf( "%s", $mime_type ) )
      if $print_mime && defined $mime_type ;
   print( join( ' ', @output ), "\n" ) ; 
}

0 ;


# Change User Description Committed
#5 190 Barrie Slaymaker Tweaked stdin feature to not break supplying a file name
#4 185 Barrie Slaymaker Allowed input to come from stdin if not file names given.

       Fixed bug in File::Type that made it return directory all
       if the option 'follow' was passed and the last -X file test
       was on a directory.
#3 168 Barrie Slaymaker Added YAPC paper, slides
#2 165 Barrie Slaymaker Applied Greg KH's license patch.
#1 162 Barrie Slaymaker First code & documentation checkin