wxWidgets/distrib/msw/tmake/lib/wxFileInfo.pm
Mattia Barbon 69c4481222 Use some wxX11 files (currently pen.cpp and brush.cpp) in wxMotif.
Add src/x11 to VPATH in configure, and add a new flag to filelist.txt
indicating a file used in wxMotif but not in wxMotif directory.
  Modifed VMS makefiles, too (should be checked by someone with VMS,
though).


git-svn-id: https://svn.wxwidgets.org/svn/wx/wxWidgets/trunk@19265 c3d73ce0-8a6f-49c7-b76d-6d57e0e08775
2003-02-20 18:20:47 +00:00

91 lines
2.2 KiB
Perl

package wxFileInfo;
=head1 NAME
wxFileInfo
=head1 SYNOPSIS
use wxFileInfo;
my $info = new wxFileInfo( $filename, $filetype, $fileflags );
my $info2 = new wxFileInfo( 'mdig.cpp', 'Generic',
'NotWin32,NotGTK,NotMac' );
$f = $info->filename;
$t = $info->filetype;
$flags = $info->fileflags;
$bool = $info->is_header;
$bool = $info->is_source;
$file = $info->object_file;
$file = $info->source_file;
$bool = $info->has_flag( 'NotX' );
=cut
use strict;
sub new {
my $ref = shift;
my $class = ref( $ref ) || $ref;
my $self = bless {}, $class;
my( $filename, $filetype, $fileflags ) = @_;
$fileflags =~ tr/ \t//d;
@{$self}{'filename', 'filetype'} = ( $filename, $filetype );
$self->{fileflags} = [ split /,/, $fileflags ];
return $self;
}
sub filename { $_[0]->{filename} }
sub filetype { $_[0]->{filetype} }
sub fileflags { $_[0]->{fileflags} }
sub is_header { scalar( $_[0]->{filename} =~ m/\.h$/i ) }
sub is_source { !scalar( $_[0]->{filename} =~ m/\.h$/i ) }
sub object_file {
my $self = shift;
my $obj = $self->{filename};
$obj =~ s/cp?p?$/o/i; # PORTABILITY
return $obj;
}
my %src_prefix = ( Common => 'common/',
Generic => 'generic/',
MSW => 'msw/',
Mac => 'mac/',
Motif => 'motif/',
GTK => 'gtk/',
Univ => 'univ/',
X11 => 'x11/',
HTML => 'html/',
Unix => 'unix/',
WXH => '',
ProtoH => 'protocol/',
HtmlH => 'html/',
MotifH => 'motif/',
X11H => 'x11/',
GenericH => 'generic/',
UnixH => 'unix/',
);
sub source_file {
my $self = shift;
my $type = $self->filetype;
die "Unknown file type '$type'" unless exists $src_prefix{$type};
return $src_prefix{$type} . $self->filename; # PORTABILITY
}
sub has_flag {
my( $self, $flag ) = @_;
$flag = lc( $flag );
return grep { lc( $_ ) eq $flag } @{$self->{fileflags}};
}
1;