<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">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-&gt;filename;
  $t = $info-&gt;filetype;
  $flags = $info-&gt;fileflags;
  $bool = $info-&gt;is_header;
  $bool = $info-&gt;is_source;
  $file = $info-&gt;object_file;
  $file = $info-&gt;source_file;
  $bool = $info-&gt;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-&gt;{fileflags} = [ split /,/, $fileflags ];

    return $self;
}

sub filename { $_[0]-&gt;{filename} }
sub filetype { $_[0]-&gt;{filetype} }
sub fileflags { $_[0]-&gt;{fileflags} }
sub is_header { scalar( $_[0]-&gt;{filename} =~ m/\.h$/i ) }
sub is_source { !scalar( $_[0]-&gt;{filename} =~ m/\.h$/i ) }

sub object_file {
    my $self = shift;
    my $obj = $self-&gt;{filename};

    $obj =~ s/cp?p?$/o/i; # PORTABILITY

    return $obj;
}

my %src_prefix = ( Common  =&gt; 'common/',
                   Generic =&gt; 'generic/',
                   MSW     =&gt; 'msw/',
                   Mac     =&gt; 'mac/',
                   Motif   =&gt; 'motif/',
                   GTK     =&gt; 'gtk/',
                   Univ    =&gt; 'univ/',
                   X11     =&gt; 'x11/',
                   HTML    =&gt; 'html/',
                   Unix    =&gt; 'unix/',
                   WXH     =&gt; '',
                   ProtoH  =&gt; 'protocol/',
                   HtmlH   =&gt; 'html/',
                   MotifH  =&gt; 'motif/',
                   X11H    =&gt; 'x11/',
                   GenericH =&gt; 'generic/',
                   UnixH   =&gt; 'unix/',
                 );

sub source_file {
    my $self = shift;
    my $type = $self-&gt;filetype;

    die "Unknown file type '$type'" unless exists $src_prefix{$type};
    return $src_prefix{$type} . $self-&gt;filename; # PORTABILITY
}

sub has_flag {
    my( $self, $flag ) = @_;
    $flag = lc( $flag );
    return grep { lc( $_ ) eq $flag } @{$self-&gt;{fileflags}};
}

1;
</pre></body></html>