Acorn User 10/AU_CD10.iso/Updates/Perl/Non-RPC/!Perl/riscos/RISCOS/File.pm

Text File | 1998-11-28 | 12KB | 399 lines

package RISCOS::File;

require Exporter;
use Carp;
# use RISCOS::Filespec qw (canonicalise);
# it's a builtin, and don't want to turn off conversion in makeddf
use RISCOS::SWI;
use strict;
use vars qw ($os_file $VERSION @ISA @EXPORT_OK $AUTOLOAD);

$VERSION = 0.08;
@ISA = qw(Exporter);

@EXPORT_OK = qw(settype gettype globlist load os_file filetype getdatestamp
        copy glob_control fileglob_PrintExpandedPaths
        fileglob_PrintOriginalPath fileglob_PrintPathMask
        fileglob_IncludeDotFiles fileglob_SkipDotFiles
        fileglob_DotFilesMask fileglob_DontSplitOnWhitespace
        fileglob_WhitespaceMask fileglob_SplitOnWhitespace
        fileglob_ImagesAreFiles fileglob_ImagesAreDirectories
        fileglob_ImagesMask );

# The fileglob magic numbers are in riscos.c

sub globlist
{
    my (@globbed);
    map {
    @globbed = glob ($_);
    # Push the glob pattern if it doesn't match
    # (ie emulate unix shell behaviour)
    @globbed ? @globbed : $_;
    } @_
}

sub load ($) {
    return undef unless my $file = shift;
    # If passed ref to scalar assume that we have been given the file's contents
    return $$file if ref($file) eq 'SCALAR' or ref($file) eq 'LVALUE';

    local *FILE;

    if (ref($file) ? (ref($file) eq 'GLOB'
              || UNIVERSAL::isa($file, 'GLOB')
              || UNIVERSAL::isa($file, 'IO::Handle'))
           : (ref(\$file) eq 'GLOB'))
    {
    *FILE = $file;
    }
    else
    {
    open FILE, "<$file" or croak "Unable to open '$file': $!";
    }
    local $/; undef $/;

    return scalar <FILE> unless wantarray;    # Schluuuuuuuurp!

    my @result = os_file (5, \*FILE);
    return scalar <FILE> unless @result;
    (scalar (<FILE>), @result[0..5]);
}

sub AUTOLOAD {
    my($constname);
    ($constname = $AUTOLOAD) =~ s/.*:://;
    my $val = RISCOS::File::constant($constname);
    croak "Undefined subroutine $AUTOLOAD" unless defined $val;
    eval "sub $AUTOLOAD { $val }";
    goto &$AUTOLOAD;
}

sub os_file ($$;) {
    return wantarray ? () : undef unless defined $_[0] and defined $_[1];
    # Make sure that we don't clobber the original value
    splice @_,1,1, RISCOS::Filespec::riscosify $_[1];
    unshift @_, $os_file;
    my $result = &kernelswi;    # Pass on modified arguments;
    return (wantarray ? () : undef) unless defined $result;
    return unpack 'I10', $result if wantarray;
    unpack 'I', $result;
}

sub filetype {
    return (defined $_[0] and ($_[0] & 0xFFF00000) == 0xFFF00000)
          ? ($_[0] >> 8) & 0xFFF : undef
      unless wantarray;
    map  { (defined $_ and ($_ & 0xFFF00000) == 0xFFF00000)
          ? ($_ >> 8) & 0xFFF : undef } @_;
}

sub gettype {
    # "Comments are for wimps" :-)
    filetype map {
        # Can I combine these two lines in some way without triggering warnings
        # with -w and undefined filenames?
    my $result = kernelswi ($os_file, 5, RISCOS::Filespec::riscosify $_);
    # Check there was no error and it was found
    defined ($result) and unpack ('I', $result)
     ? unpack ('x8I', $result) : undef;
    } @_;
}

sub _getdatestamp {
    my $result = kernelswi ($os_file, 5, RISCOS::Filespec::riscosify $_[0]);
    (defined ($result) and (unpack 'I', $result)
    and (unpack ('x8I', $result) & 0xFFF00000) == 0xFFF00000)
      ? substr ($result, 12, 4) .  substr ($result, 8, 1) : undef;
    # Look at the StrongHelp load and exec address page - if you store
    # R3 and R2 in memory in that order you get dddddddd cctttff
}

sub getdatestamp {
    goto &_datestamp unless wantarray;
    map {_datestamp $_} @_
}

$os_file = SWINumberFromString('OS_File');
__END__

=head1 NAME

RISCOS::File -- native file operations

=head1 SYNOPSIS

    use RISCOS::File 'globlist';
    @ARGV = globlist (@ARGV);
    # Simulate Unix-like filename globbing of command line arguments

    use RISCOS::File 'os_file';
    @info = os_file 'perl';

=head1 DESCRIPTION

C<RISCOS::File> provides S<RISC OS> specific functions to access files, and a
function C<globcontrol> to control the globbing performed by the perl builtins
C<< E<gt>> and C<glob>.

=over 4

=item settype <type>, <filename>...

Sets the filetype of a list of files. I<filename> can actually be a reference to
a filehandle, and I<type> can be specified as a number or a string - strings are
passed to C<OS_FSControl 31> which will also convert hexadecimal strings such as
C<FFF> and C<&102> to numbers.

Returns 0 for complete success, 1 if any errors occurred.

=item gettype <filename>...

Returns the numeric filetype of a list of files, or in scalar context the
filetype of the first file. As you might expect I<filename> can also be a
filehandle (I<i.e> reference to a typeglob, or an IO object). Returns C<undef>
for filenames/handles that do not correspond to disc files, or to files that are
untyped.

=item getdatestamp <filename>...

In scalar context the returns the datestamp of the first file as a 5 byte
scalar, or C<undef> for filenames/handles that do not correspond to disc files,
or to files that are untyped. In array context returns the list of datestamps
corresponding to the list of files.

=item globlist

Passes a list of patterns to glob, and returns an list of the results. If any
pattern matches zero files, it is returned verbatim (the same approach used by
Unix shells). Note that this differs from C<< E<gt>> and C<glob>, which return
an empty list if the pattern does not match.

=item load <file>

Loads the file specified. If I<file> is actually a reference to a scalar, it is
taken as referring to the contents of the notional file, and this is returned.
If I<file> is a reference to a handle, this is used, otherwise I<file> is taken
to be a filename.

In scalar context returns the file contents, or undefined for failure. In array
context returns an array  S<(I<file contents>, C<os_file (5, I<file>)>)>, or an
array (I<file contents>) if C<os_file 5> fails (I<e.g.> the handle could not be
converted to a filename).

=item os_file <reason>, <filename>

Performs the specified C<OS_File>. Returns C<R0> in scalar context, an array of
C<R0>-C<R9> in array context. Oddly enough I<filename> can actually be a
filehandle, which is converted to a filename to call C<OS_File>.

=item filetype <load addr>...

C<filetype> returns the numberic filetype from the load address given, or
C<undef> if the load address is not for a stamped file. In scalar context it
returns the filetype from the first argument, in array context C<filetype>
returns a list of filetypes corresponding to the argument list.

=item copy <from>, <to> [, <flags>]

C<copy> calls the S<RISC OS> C<*copy> command copy to copy a file
(C<OS_FSControl 26> to be precise). I<flags> default to 0 [*], and are as
for C<OS_FSControl 26> I<except> that bit 13 is toggled. This means that
by default an appropriately sized user buffer is provided internally, avoiding
problems copying to/from archives. [Appropriately sized is currently
implemented as C<min( I<filesize>, 128K )> ]. If I<to> or I<from> are
filehandles then they are converted to filenames (if possible) before calling
C<OS_FSControl 26>.

* If flags are not supplied then force is turned on unless the target is
locked. This means that you can copy over a destination file automatically.

=back

=head2 glob_control

C<glob_control> allows the script to control various options that control how
the C<< E<gt>> operator and underlying C<glob> function work. C<glob_control>
returns the current/old setting of the control flags. If passed a defined value
it uses this as the new flag settings, otherwise the control flags are left
unchanged. C<glob_control> will C<croak> if reserved bits in the flags are not
zero - always use the C<fileglob_*> subroutines provided to construct flag
settings.

=over 4

=item fileglob_PrintExpandedPaths

the default setting - causes globbing to (recursively) expand Path variables
passed in. With this

    glob ('System:Modules.a*')

returns

    ADFS::Bagpuss.$.!BOOT.Resources.!System.310.Modules.ABCLib
    ADFS::Bagpuss.$.!BOOT.Resources.!System.310.Modules.ABIMod
    ADFS::Bagpuss.$.!BOOT.Resources.!System.Modules.ABIMod


System:Modules.ABCLib
System:Modules.ABIMod
System:Modules.ABIMod

=item fileglob_PrintOriginalPath

causes globbing output to retain Path variables passed in, although recursive
expansion is used internally. Setting this turns off
I<fileglob_PrintExpandedPaths>, likewise setting I<fileglob_PrintExpandedPaths>
turns off I<fileglob_PrintOriginalPath>. If both are set the result is
undefined.

With this

    glob ('System:Modules.a*')

returns

    System:Modules.ABCLib
    System:Modules.ABIMod
    System:Modules.ABIMod

=item fileglob_PrintPathMask

bitmask of the acceptable values for the above printing options.

=item fileglob_IncludeDotFiles

When filename conversion is on, globbing a pattern not starting 'C<*>' includes
files starting 'C</>' - I<i.e.> Unix "dot" files mapped to S<RISC OS>.

When filename conversion is off this flag has no effect.

=item fileglob_SkipDotFiles

When filename conversion is on, globbing a pattern not starting 'C<*>' does not
include files starting 'C</>' - use a pattern explicitly starting 'C</>',
I<e.g.> 'C</*>' to match these files. This is the default setting, as it is
consistent with Unix.

When filename conversion is off this flag has no effect.

=item fileglob_DotFilesMask

bitmask of the acceptable values for the above dot files options.

=item fileglob_SplitOnWhitespace

This is the default setting.With this flag C<glob> will split patterns on whitespace, and glob on each
section. So

    <aa* *q*z>

will glob as

    <aa*>
    <*q*z>

This is consistent with Unix, and consistent with Fileswitch taking 'C< >' and
other whitespace as the end of a filename. This is the default setting.

=item fileglob_DontSplitOnWhitespace

With this flag C<glob> takes no special notice of whitespace.

=item fileglob_WhitespaceMask

bitmask of the acceptable values for the above whitespace options.

=item fileglob_ImagesAreDirectories

This is the default setting - with this flag C<glob> will treat any images it
finds in the path being globbed just like directories, and match against their
contents. This is consistent with the behaviour of the desktop filer.

=item fileglob_ImagesAreFiles

With this flag C<glob> will treat non-leaf images as files, not directories.
This means that C<glob> will not return the contents of any images.

So if F<$.FestiveRd> is an image containing 2 files F<52> and F<Shop>,

    glob "\$.FestiveRd.*"

or

    glob "\$.Festi##Rd.*"

will return

    $.FestiveRd.52
    $.FestiveRd.Shop

with the normal behaviour, but



(I<i.e.> nothing) with this flag enabled, as images are to be treated as normal
files now, and hence listing the contents in any way is forbidden.

This flag has B<no> effect on image files found as B<leaf>names in globbing
patterns, as C<glob> makes no distinction between files, images, directories,
(or any future object type) found as a leafname.

Note that any non-ADFS floppy disks are actually image files - with this flag
set C<glob "ADFS::0.\$.*"> will B<not> give a listing of the root directory of
an C<MS-DOS> floppy, because a check will be made on C<$>, which is actually
an image, not a directory. This is a documented consequence of the S<RISC OS>
implementation of foreign format discs.

Note also that this flag only affects C<glob>, and no other part of perl. In
particular C<-d> will still return true and C<-f> false for an image.

=item fileglob_WhitespaceMask

bitmask of the acceptable values for the above image options.

=back

=head1 BUGS

Not so much bugs in this module but points to note with the port's core
globbing:

C<glob> relies on C<OS_GBPB> to perform globbing, so in theory will work with
case sensitive filesystems (which the PRM states are allowed). This means that

=over 4

=item *

Unix globs with ranges enclosed in C<[]> do not work.

=item *

glob results are not sorted - they are returned in the same order as the
filesystem returns via C<OS_GBPB>. This means that:

=over 4

=item *

For S<RISC OS> filesystems that return filenames in sorted order, this order is
case B<insensitive>, whereas Unix glob returns filenames in case sensitive
order.

=item *

Not all S<RISC OS> filesystems sort their directory output in any way.

=back

=back

The upshot is if you really need the output from globbing to be sorted, C<sort>
it yourself.

=head1 AUTHOR

Nicholas Clark <F<[e-mail]>>