summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl0/lib/Win32/File/Object.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl0/lib/Win32/File/Object.pm')
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/File/Object.pm450
1 files changed, 450 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl0/lib/Win32/File/Object.pm b/Master/tlpkg/tlperl0/lib/Win32/File/Object.pm
new file mode 100755
index 00000000000..bb4aa90ecdc
--- /dev/null
+++ b/Master/tlpkg/tlperl0/lib/Win32/File/Object.pm
@@ -0,0 +1,450 @@
+package Win32::File::Object;
+
+=pod
+
+=head1 NAME
+
+Win32::File::Object - Simplified object abstraction over Win32::File
+
+=head1 SYNOPSIS
+
+ # Get a handle for the file.
+ my $object = Win32::File::Object->new( $filename, $autowrite );
+
+ # Read a property flag for the file.
+ my $readonly = $object->readonly;
+
+ # Set a propertly flag for the file.
+ $object->readonly(1);
+
+ # If autowrite is false, write the changes to the file.
+ $object->write;
+
+=head1 DESCRIPTION
+
+L<Win32::File> is an interface to the Win32 API for file
+attributes.
+
+Unfortunately it is a B<direct> interface to the underlying Win32 API,
+with a completely non-Perlish interface involving CamelCase function
+names, bit-field flags and return-by-param.
+
+B<Win32::File::Object> is a straight-forward object-oriented Perlish
+wrapper around the raw underlying API wrapper.
+
+=head1 METHODS
+
+=cut
+
+use 5.006;
+use strict;
+use Carp ();
+use Win32::File ();
+
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '0.02';
+}
+
+
+
+
+
+#####################################################################
+# Constructor
+
+=pod
+
+=head2 new
+
+ my $file = Win32::File::Object->new( $path, $autowrite );
+
+The C<new> constructor creates a new handle to the Win32 filesystem
+attributes of an existing file or directory.
+
+The compulsory C<$filename> parameter is the name of the file or
+directory to create the handle on.
+
+The optional C<$autowrite> parameter, if true, indicates that the
+object should write the filesystem attributes to the file every
+time the method is called to set the property.
+
+If the C<$autowrite> param is false or not provided, you will
+need to call an explicit C<write> method in order to apply the
+changes to the file.
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $path = shift;
+ my $autowrite = !! shift;
+ unless ( $path ) {
+ Carp::croak("Did not provide a file name");
+ }
+ unless ( -f $path ) {
+ Carp::croak("File '$path' does not exist");
+ }
+
+ # Create the object
+ my $self = bless {
+ path => $path,
+ autowrite => $autowrite,
+ rollback => ! 1,
+ }, $class;
+
+ # Get the attributes
+ $self->read;
+
+ return $self;
+}
+
+=pod
+
+=head2 path
+
+The C<path> accessor returns the original file path as provided to
+the constructor as a string.
+
+=cut
+
+sub path {
+ $_[0]->{path};
+}
+
+=pod
+
+=head2 autowrite
+
+The C<autowrite> accessor returns true if the object will
+automatically write changes to the filesystem, or false if
+not.
+
+=cut
+
+sub autowrite {
+ $_[0]->{autowrite};
+}
+
+
+
+
+
+#####################################################################
+# Main Methods
+
+=pod
+
+=head2 read
+
+the C<read> method reads (updates) the filesystem attributes, in case
+they have been updated since the object was originally created.
+
+Returns true on success or throws an exception (dies) on error.
+
+=cut
+
+sub read {
+ my $self = shift;
+
+ # Read the bitfield
+ my $bits;
+ my $path = $self->path;
+ unless ( Win32::File::GetAttributes( $self->path => $bits ) ) {
+ Carp::croak("GetAttributes failed for '$path'");
+ }
+
+ # Read the flags
+ $self->{archive} = ( $bits & Win32::File::ARCHIVE() ) ? 1 : 0;
+ $self->{compressed} = ( $bits & Win32::File::COMPRESSED() ) ? 1 : 0;
+ $self->{directory} = ( $bits & Win32::File::DIRECTORY() ) ? 1 : 0;
+ $self->{hidden} = ( $bits & Win32::File::HIDDEN() ) ? 1 : 0;
+ $self->{normal} = ( $bits & Win32::File::NORMAL() ) ? 1 : 0;
+ $self->{offline} = ( $bits & Win32::File::OFFLINE() ) ? 1 : 0;
+ $self->{readonly} = ( $bits & Win32::File::READONLY() ) ? 1 : 0;
+ $self->{system} = ( $bits & Win32::File::SYSTEM() ) ? 1 : 0;
+ $self->{temporary} = ( $bits & Win32::File::TEMPORARY() ) ? 1 : 0;
+
+ return 1;
+}
+
+=pod
+
+=head2 write
+
+the C<write> method writes the object attributes back to the filesystem.
+
+Returns true on success or throws an exception (dies) on error.
+
+=cut
+
+sub write {
+ my $self = shift;
+
+ # Generate the bitfield from the attributes
+ my $bits = 0;
+ if ( $self->archive ) {
+ $bits += Win32::File::ARCHIVE();
+ }
+ if ( $self->compressed ) {
+ $bits += Win32::File::COMPRESSED();
+ }
+ if ( $self->directory ) {
+ $bits += Win32::File::DIRECTORY();
+ }
+ if ( $self->hidden ) {
+ $bits += Win32::File::HIDDEN();
+ }
+ if ( $self->normal ) {
+ $bits += Win32::File::NORMAL();
+ }
+ if ( $self->offline ) {
+ $bits += Win32::File::OFFLINE();
+ }
+ if ( $self->readonly ) {
+ $bits += Win32::File::READONLY();
+ }
+ if ( $self->system ) {
+ $bits += Win32::File::SYSTEM();
+ }
+ if ( $self->temporary ) {
+ $bits += Win32::File::TEMPORARY();
+ }
+
+ # Apply the attributes to the file
+ my $path = $self->path;
+ unless ( Win32::File::SetAttributes( $path, $bits ) ) {
+ Carp::croak("SetAttributes failed for '$path'");
+ }
+
+ return 1;
+}
+
+
+
+
+
+#####################################################################
+# Attribute Methods
+
+=pod
+
+=head2 archive
+
+ # Get the value
+ my $archive = $file->archive;
+
+ # Set the value
+ $file->archive(1);
+
+The C<archive> accessor gets or set the Win32 "archive" status for
+the file.
+
+=cut
+
+sub archive {
+ shift->_attr( archive => @_ );
+}
+
+=pod
+
+=head2 compressed
+
+ # Get the value
+ my $compressed = $file->compressed;
+
+ # Set the value
+ $file->compressed(1);
+
+The C<compressed> accessor gets or set the Win32 "compressed" status
+for the file.
+
+=cut
+
+sub compressed {
+ shift->_attr( compressed => @_ );
+}
+
+=pod
+
+=head2 directory
+
+ # Get the value
+ my $directory = $file->directory;
+
+ # Set the value
+ $file->directory(1);
+
+The C<directory> accessor gets or set the Win32 "directory" status for
+the file.
+
+=cut
+
+sub directory {
+ shift->_attr( directory => @_ );
+}
+
+=pod
+
+=head2 hidden
+
+ # Get the value
+ my $hidden = $file->hidden;
+
+ # Set the value
+ $file->hidden(1);
+
+The C<hidden> accessor gets or set the Win32 "hidden" status for
+the file.
+
+=cut
+
+sub hidden {
+ shift->_attr( hidden => @_ );
+}
+
+=pod
+
+=head2 normal
+
+ # Get the value
+ my $normal = $file->normal;
+
+ # Set the value
+ $file->normal(1);
+
+The C<normal> accessor gets or set the Win32 "normal" status for
+the file.
+
+=cut
+
+sub normal {
+ shift->_attr( normal => @_ );
+}
+
+=pod
+
+=head2 offline
+
+ # Get the value
+ my $offline = $file->offline;
+
+ # Set the value
+ $file->offline(1);
+
+The C<offline> accessor gets or set the Win32 "offline" status for
+the file.
+
+=cut
+
+sub offline {
+ shift->_attr( offline => @_ );
+}
+
+=pod
+
+=head2 readonly
+
+ # Get the value
+ my $readonly = $file->readonly;
+
+ # Set the value
+ $file->readonly(1);
+
+The C<readonly> accessor gets or set the Win32 "readonly" status for
+the file.
+
+=cut
+
+sub readonly {
+ shift->_attr( readonly => @_ );
+}
+
+=pod
+
+=head2 system
+
+ # Get the value
+ my $system = $file->system;
+
+ # Set the value
+ $file->system(1);
+
+The C<system> accessor gets or set the Win32 "system" status for
+the file.
+
+=cut
+
+sub system {
+ shift->_attr( system => @_ );
+}
+
+=pod
+
+=head2 temporary
+
+ # Get the value
+ my $temporary = $file->temporary;
+
+ # Set the value
+ $file->temporary(1);
+
+The C<temporary> accessor gets or set the Win32 "temporary" status for
+the file.
+
+=cut
+
+sub temporary {
+ shift->_attr( temporary => @_ );
+}
+
+sub _attr {
+ my $self = shift;
+ my $name = shift;
+ my $new = $_[0] ? 1 : 0;
+ return $self->{$name} unless @_;
+ return $self->{$name} if $new == $self->{$name};
+
+ # Set the rollback if needed
+ if ( $self->{rollback} and ! exists $self->{rollback}->{$name} ) {
+ $self->{rollback}->{$name} = $new;
+ }
+
+ # Set the new value
+ $self->{$name} = $new;
+ $self->write if $self->autowrite;
+
+ return $self->{$name};
+}
+
+1;
+
+=pod
+
+=head1 SUPPORT
+
+Bugs should be reported via the CPAN bug tracker at
+
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Win32-File-Object>
+
+For other issues, or commercial enhancement or support, contact the author.
+
+=head1 AUTHOR
+
+Adam Kennedy E<lt>adamk@cpan.orgE<gt>
+
+=head1 SEE ALSO
+
+L<Win32::File>
+
+=head1 COPYRIGHT
+
+Copyright 2008 - 2009 Adam Kennedy.
+
+This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+The full text of the license can be found in the
+LICENSE file included with this module.
+
+=cut