distrib/msw/tmake/lib/wxFileInfo.pm

   1 package wxFileInfo;
   2
   3 =head1 NAME
   4
   5 wxFileInfo
   6
   7 =head1 SYNOPSIS
   8
   9   use wxFileInfo;
  10
  11   my $info = new wxFileInfo( $filename, $filetype, $fileflags );
  12   my $info2 = new wxFileInfo( 'mdig.cpp', 'Generic',
  13                               'NotWin32,NotGTK,NotMac' );
  14
  15   $f = $info->filename;
  16   $t = $info->filetype;
  17   $flags = $info->fileflags;
  18   $bool = $info->is_header;
  19   $bool = $info->is_source;
  20   $file = $info->object_file;
  21   $file = $info->source_file;
  22   $bool = $info->has_flag( 'NotX' );
  23
  24 =cut
  25
  26 use strict;
  27
  28 sub new {
  29     my $ref = shift;
  30     my $class = ref( $ref ) || $ref;
  31     my $self = bless {}, $class;
  32
  33     my( $filename, $filetype, $fileflags ) = @_;
  34     $fileflags =~ tr/ \t//d;
  35
  36     @{$self}{'filename', 'filetype'} = ( $filename, $filetype );
  37     $self->{fileflags} = [ split /,/, $fileflags ];
  38
  39     return $self;
  40 }
  41
  42 sub filename { $_[0]->{filename} }
  43 sub filetype { $_[0]->{filetype} }
  44 sub fileflags { $_[0]->{fileflags} }
  45 sub is_header { scalar( $_[0]->{filename} =~ m/\.h$/i ) }
  46 sub is_source { !scalar( $_[0]->{filename} =~ m/\.h$/i ) }
  47
  48 sub object_file {
  49     my $self = shift;
  50     my $obj = $self->{filename};
  51
  52     $obj =~ s/cp?p?$/o/i; # PORTABILITY
  53
  54     return $obj;
  55 }
  56
  57 my %src_prefix = ( Common  => 'common/',
  58                    Generic => 'generic/',
  59                    MSW     => 'msw/',
  60                    Mac     => 'mac/',
  61                    Motif   => 'motif/',
  62                    GTK     => 'gtk/',
  63                    Univ    => 'univ/',
  64                    X11     => 'x11/',
  65                    HTML    => 'html/',
  66                    Unix    => 'unix/',
  67                    WXH     => '',
  68                    ProtoH  => 'protocol/',
  69                    HtmlH   => 'html/',
  70                    MotifH  => 'motif/',
  71                    X11H    => 'x11/',
  72                    GenericH => 'generic/',
  73                    UnixH   => 'unix/',
  74                  );
  75
  76 sub source_file {
  77     my $self = shift;
  78     my $type = $self->filetype;
  79
  80     die "Unknown file type '$type'" unless exists $src_prefix{$type};
  81     return $src_prefix{$type} . $self->filename; # PORTABILITY
  82 }
  83
  84 sub has_flag {
  85     my( $self, $flag ) = @_;
  86     $flag = lc( $flag );
  87     return grep { lc( $_ ) eq $flag } @{$self->{fileflags}};
  88 }
  89
  90 1;