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 is an interface to the Win32 API for file attributes. Unfortunately it is a B interface to the underlying Win32 API, with a completely non-Perlish interface involving CamelCase function names, bit-field flags and return-by-param. B 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 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 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 accessor returns the original file path as provided to the constructor as a string. =cut sub path { $_[0]->{path}; } =pod =head2 autowrite The C 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 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 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 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 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 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 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 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 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 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 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 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 For other issues, or commercial enhancement or support, contact the author. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 SEE ALSO L =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