Category: | Win32 stuff |
Author/Contact Info | Chris Monahan aka Maze ForeverWatcher@googlemail.com |
Description: | a simple listing script for associations on a win32 system like assoc for win 2000/XP - there is now some limited support for changing extensions but it's buggy, due to the way windows behaves to third party changing of the associations - that's purely cosmetic though however there is no creating or deleting of extensions: I think this might be a bug in the TieRegistry.pm because it doesn't seem to be able to create or delete key 'default' values could be used on win 9.x or others without assoc since 0.1 added options and help and rewrote to make clearer (thanks ikegami) but for some reason looking up a specific extension has been broken... at a loss here... since: 0.2 fixed bugs - albiet a little sloppily turns out looking up specific extension was just me using = instead of ==, *slaps forhead* since: 0.25 added functionality for changing (not deleting or creating) a single association and listing more than one extension, also a foil to bail when it tries to be executed in a non win32 enviroment since: 0.3 bugfixes, code cleanup (/F switch now applies to all output) applied deletion and creation #code according to TieRegistry documentation, doesn't seem to work though |
#!/usr/bin/perl #perl-assoc 0.4 #by Christopher Monahan + help from perl monks # #This is free software, you can distribute it under the same #terms as perl itself # ### a simple listing script for associations on a win32 system ### like assoc for win 2000/XP - there is now some limited support ### for changing extensions but it's buggy, due to the way windows +behaves ### to third party changing of the associations - that's purely cos +metic though ### however there is no creating or deleting of extensions: ### I think this might be a bug in the TieRegistry.pm because it d +oesn't ### seem to be able to create or delete key 'default' values ### ###could be used on win 9.x or others without assoc #since 0.1 added options and help and rewrote to make clearer (thanks +ikegami) #but for some reason looking up a specific extension has been broken.. +. at a loss here... #since: 0.2 fixed bugs - albiet a little sloppily turns out looking up + specific extension #was just me using = instead of ==, *slaps forhead* #since: 0.25 added functionality for changing (not deleting or creatin +g) a single association #and listing more than one extension, also a foil to bail when it trie +s to be executed in a #non win32 enviroment #since: 0.3 bugfixes, code cleanup (/F switch now applies to all outpu +t) applied deletion and creation #code according to TieRegistry documentation, doesn't seem to work tho +ugh use warnings; use strict; unless ($^O =~ /Win32/){ die "This program requires a full Win32 enviroment" #note this doesn't + actually work } else{## not using indents for the master block because it's so huge an +d boring use Win32::TieRegistry (Delimiter => ":"); #note: for my foil to work I actually need to wrap 'use Win32::TieRegi +stry' in some test for whether it exists or not #declare my variables my $ext; my $RegHash; my $class; my $extcnt = 0; my $warnalert; my @conversion_vals; #define subroutines -- sub scan { #for scanning arrays in general my $hunt = $_[0]; my @founda = 0; # if (defined($hunt)){ @founda = grep {/$hunt/} @_; # } # else{ # $founda[$#_] = 1; # } return $#founda; } sub help { # output help print<<EOF; perl-assoc 0.2 Displays file extension associations -to see particular extensions: ASSOC .ext1 .ext2 .ext3... [options] .ext Specifies the file extension to display -to see all file extensions: ASSOC [options] will show a list of all known file associations -to change a single extension association (creating/destroying associa +tions not yet supported): ASSOC .ext=filetype filetype specifies what identifier this extension will use in the +registry and the interface available options are: (case sensitive) /W - warn about extensions not assigned with a filetype /F - format output with padding eg: assoc .htm .pl /F might give you: .htm \t = \t FireFoxHTML .pl \t = \t Perl EOF } sub mainlist {#simple abstraction for problem with calling with no var +iables foreach my $ext (keys %{ $Registry->{"Classes:"} }) { next unless substr($ext, 0, 1) eq '.'; my $RegHash = $Registry->{"Classes:$ext"}; if (not exists $RegHash->{':'}) { print "\t --No filetype associated with $ext\n" if scan("/W", @_); next; } my $class = $RegHash->{":"}; chop $ext; report ($ext, $class); } } sub report {# worksaving sub for reporting the findings if (scan ("/F", @ARGV)){ print "$_[0] \t = \t $_[1] \n"; } else { print "$_[0]=$_[1] \n"; } } sub regattack {# sub for interacting with the registry if (substr ($_[1] ,0,1) eq '.'){ $ext = $_[1]; } if (defined $_[2]){ $class = $_[2]; } $RegHash = $Registry->{"Classes:$ext"}; if ($_[0] eq "read"){ return $RegHash->{":"} } elsif ($_[0] eq "write"){ $RegHash->{":"} = $class; } elsif ($_[0] eq "delete"){ delete $RegHash->{":"};#for some reason deleting or creating a + keys default value silently fails } else {return 0} } if(@ARGV){#-beginning of silly solution for calling it with no variabl +es #finding pleas for help if ($ARGV[0] =~ /\/\?|[Hh][Ee][Ll][Pp]/) { help(); } # #what to do when called with extension's (plural) elsif (substr ($ARGV[0] ,0,1) eq '.'){ if ($ARGV[0] =~ /=$/){ $ext = chop ($ARGV[0]); regattack("delete", $ext);#see regattack } elsif ($ARGV[0] =~ /=/){ @conversion_vals = split (/=/, $ARGV[0]); if (@conversion_vals == 2){ regattack ("write", $conversion_vals[0], $conversion_v +als[1]); report($conversion_vals[0], $conversion_vals[1]); } } else{ my $ARGmask = [@ARGV, "end"]; #because otherwise it'll com +plain when it reaches the end while (substr ($ARGmask->[$extcnt] ,0,1) eq '.'){ $ext = $ARGmask->[$extcnt]; $RegHash = $Registry->{"Classes:$ext"}; $warnalert = 0; if (not exists $RegHash->{':'}) { if (scan("/W", @ARGV)) {print "\t --No filetype fo +und associated with $ext\n"} else { report ($ext, "?"); $warnalert = 1; } $warnalert = 1; } unless($warnalert){ my $class = regattack ("read", $ext); report($ext, $class) } $extcnt++ } } } # #and finally when all else fails just list else { mainlist(@ARGV); } } else {#-end of silly solution for calling it with no varibles mainlist(); } } #end of master block #to-do# # #my foil for executing outside of a Win32 enviroment doesn't seem to b +e working, find out some way of getting that to work #need to find out why I can't seem to create a default value when one +doesn't already exist #since it'll have to be renamed to work on NT, add a sub for pinpointi +ng the name used to run it for use in the help sub #abstract common functions as it gets larger, can't rely on copy and p +aste # possibly find a solution for the issue of the windows shell not upda +ting to reflect changes to registry ##in future possibly extending it to advanced functions for extensions + (why settle for what MS has given you?) ##eg: loading and saving sets of extension modification, advanced shel +l functions, wildcard use |
Back to
Code Catacombs