package MRUList;
require 5.005_62;
use strict;
use warnings;
use Carp;
my $version = "0.3";
use Win32::TieRegistry( Delimiter=>"/" );

sub new {
   my $class = shift;
   croak('Odd number of args'."$class->new(" . join(',',@_) .')') if @_ % 2;
   ## TODO: complain about unrecognised args.
   my $self  = {};         # allocate new hash for object
   bless($self, $class);
   ## Initialise members from params...
   my %params = @_;
   $self->{MAXRECENT} = checkmaxrecent($params{-maxrecent});
   $self->{GROUPNAME} = ( $params{-groupname} or 'MRUList');
   $self->{APPNAME} = ( $params{-appname} or 'MRUList');
   $self->{RECENTNAME} = ( $params{-recentname} or 'MRUList');
   $self->{RECENTVALS} = [];
   my $valsref = $params{-values};
   if (ref($valsref) eq 'ARRAY') {
      @$valsref = @{$self->{RECENTVALS}};
   }
   return $self;
}

sub DESTROY {
   my $self = shift;
   ## printf("$self dying at %s\n", scalar localtime);
}

## Accessors (simple)...
sub groupname {
   my $self = shift;
   my $prev = $self->{GROUPNAME};
    if (@_) { $self->{GROUPNAME} = shift } 
    return $prev;
}
sub appname {
   my $self = shift;
   my $prev = $self->{APPNAME};
    if (@_) { $self->{APPNAME} = shift } 
    return $prev;
}
sub recentname {
   my $self = shift;
   my $prev = $self->{RECENTNAME};
    if (@_) { $self->{RECENTNAME} = shift } 
    return $prev;
}
sub maxrecent {
   my $self = shift;
   my $prev = $self->{MAXRECENT};
   my $new = shift or return $prev;
   $self->{MAXRECENT} = checkmaxrecent($new);
   return $new;
}
## Local validator function for maxrecent.
sub checkmaxrecent {
   my $defaultval = 10;
   my $new = shift or return $defaultval;
   if( $new !~ /^\d+$/ ) {
      warn "maxrecent: Not a natural integer value.\n";
      return $defaultval;
   }
   if( $new < 1 ) {
      warn "maxrecent: less that 1.\n";
      return $defaultval;
   }
   return $new;
}
## Get a copy of the list...
sub get {
   my $self = shift;
   return @{$self->{RECENTVALS}};
}
## Add the new items to the top of the list...
sub add {
   my $self = shift;
   return if not scalar @_;
   my $vr = $self->{RECENTVALS};
   my $max = $self->{MAXRECENT};
   ## Add the new items to the top of the list...
   unshift @{$vr}, @_;
   ## Tidy up and return either new length or values...
   my $len = deldupetrim($vr, $max);
   return $len unless wantarray();
   return @{$self->{RECENTVALS}};
}
## deldupetrim : Given a list reference and a length, remove 
## duplicates and trim whilst retaining original list order.
## A generic function.
sub deldupetrim {
   my ($vr, $max) = @_;
   ## Remove duplicate items...
   my %seen = ();
   @{$vr} = grep { ! $seen{$_} ++ } @{$vr};
   ## Trim list to max length - oldest values are lost...
   if( scalar(@{$vr}) > $max){
      $#$vr = $max - 1
   }
   ## Return the new length...
   return scalar @{$vr};
}

sub load {
   my $self = shift;
   ## Get the software key...
   my $swkey = $Registry->{"CUser/Software/"};
   if( ! $swkey ) {
      warn "couldn't open the software key -- too bad.\n";
      return;
   }
   my $groupname = $self->{GROUPNAME};
   my $appname = $self->{APPNAME};
   my $recentname = $self->{RECENTNAME};
   my $recent = $swkey->{"$groupname/$appname/$recentname/"};
   if( ! $recent ) {
      warn "couldn't open recent key $recentname -- too bad: $^E\n";
      return;
   }
   my $max = $self->{MAXRECENT};
   my $vr = $self->{RECENTVALS};
   ## Empty the values list...
   @{$vr} = ();
   ## Access each name in an ordered fashion...
   foreach(  sort keys %$recent ) {
      ## The names have to be digits only...
      if( ! /^\/\d+$/ ) {
         warn "bad name '$_' in recent.\n";
      } else {
         my $val = $recent->{$_};
         push @$vr, $val;
      }
   }
   ## Tidy up and return either new length or values...
   my $len = deldupetrim($vr, $max);
   return $len unless wantarray();
   return @{$self->{RECENTVALS}};
}

sub save {
   my $self = shift;
   ## Get the software key...
   my $swkey = $Registry->{"CUser/Software/"};
   if( ! $swkey ) {
      warn "couldn't open the software key -- too bad.\n";
      return;
   }
   my $groupname = $self->{GROUPNAME};
   my $appname = $self->{APPNAME};
   my $maxrecent = $self->{MAXRECENT};
   my $recentname = $self->{RECENTNAME};
   my $refvals = $self->{RECENTVALS};
   
   ## Blast the original data...
   my $recent = $swkey->{"$groupname/$appname/$recentname/"};
   undef %$recent;
   
   my $i;
   for( $i = 0; $i <@$refvals; $i++ ) {
      $swkey->{"$groupname/"}= {
         "$appname/" => {
            "$recentname/" => {
               "/$i" => $refvals->[$i],
            }
         }
      };
      last if $i >= $maxrecent;
   }
   ## Return the number of vals...
   return scalar @$refvals;
}

1;
__END__

# Below is the documentation for the module.

=head1 NAME

MRUList - Perl extension for storing and retrieving 
Most-Recently-Used lists in the Windows Registry.

=head1 SYNOPSIS

   use MRUList;
   my $recentfiles = new MRUList( -maxrecent => '4', 
                                   -recentname => 'RecentFiles',
                                   -appname => 'MyEditor',
                                   -groupname => 'MySoftwareHouse',
                                   -values => ['c:/boot.ini', 'c:/config.sys', 'c:/temp/tmp1.txt'] );
   ## Write to registry...
   $recentfiles->save; 
   
   ## Add new entries - the oldest entries will be lost if maxrecent is 
   ## reached...
   $recentfiles->add( 'c:/hat.txt', 'c:/coat.txt' );
   
   ## Some other time - load values from the registry...
   my $recentfiles = new MRUList( -maxrecent => '4', 
                                   -recentname => 'RecentFiles',
                                   -appname => 'MyEditor',
                                   -groupname => 'MySoftwareHouse',);
   $recentfiles->load;

=head1 DESCRIPTION

This module is a registry-stored Most-Recently-Used list (and hence is
Win32-specific) which I find to be a common requirement of many of my 
apps. When used thus...

   my $mru  = new MRUList;
   $mru ->add( qw( hat coat scarf ));
   $mru ->add( qw( car boat ship ));
   $mru ->save;

...one would find some numbered registry keys populated thus...

   [HKEY_CURRENT_USER\Software\MRUList\MRUList\MRUList]
   "0"="car"
   "1"="boat"
   "2"="ship"
   "3"="hat"
   "4"="coat"
   "5"="scarf"

The "\MRUList\MRUList\MRUList" branch is the default key which can 
be adjusted by setting the 3 members "groupname", "appname", and 
"recentname" accordingly which I find allows the separation and 
granularity I generally need: e.g. one can be set the software vendor 
name in "groupname" say, "SuperPerlSoft", the particular application 
name can be set in "appname" say, "GoodEditor", and "recentname" 
allows multiple lists per application such as 
"MostRecentlyTrashedFiles"...

   use MRUList;
   my $recentfiles = new MRUList( 
      -maxrecent => '10', 
      -recentname => 'RecentFiles',
      -appname => 'MyEditor',
      -groupname => 'MySoftwareHouse',
      -values => ['c:/boot.ini', 'c:/config.sys', 'c:/temp/tmp1.txt'] 
   );
   $recentfiles->save;

...would result in the following registry key being populated...

   [HKEY_CURRENT_USER\Software\MySoftwareHouse\MyEditor\RecentFiles]
   "0"="c:/boot.ini"
   "1"="c:/config.sys"
   "2"="c:/temp/tmp1.txt"

...and a corresponding "load" method retrieves these values from the 
registry and the dump method simply uses Data::Dumper...

   use MRUList;
   my $recentfiles = new MRUList( -maxrecent => '10', 
                                   -groupname => 'MySoftwareHouse',
                                   -appname => 'MyEditor',
                                   -recentname => 'RecentFiles',
                                   );
   my @files = $recentfiles->load;
   print "Recent files = \n".join("\n", @files)."\n";

...would result in...

   Recent files = 
   c:/boot.ini
   c:/config.sys
   c:/temp/tmp1.txt 

Now, although this module is an exercise in learning for the author, 
I believe this to be of wider use if it were to be made a little less 
Win32-specific (BTW: the load & save methods need never be used!).
I am appealing to anyone interested to cast an eye over it 
and perhaps suggest some improvements.

My next step is to wrap this in a 
number of Tk widgets (a menu, a comboentry, etc.) to provide some 
persistent dynamic GUI element features that I often require.

=head2 EXPORT

None by default.

=head1 BUGS

Should be Win32::MRUList because it is Win32-specific but the fact 
that it is Win32-specific is a bug in itself! The aim is to make this
package work on other platforms (perhaps with .rc files or simillar).

=head1 SEE ALSO

perl(1). Win32::TieRegistry

=head1 AUTHOR

Michael Erskine michael.erskine@tecspy.com

=head1 COPYRIGHT AND DISCLAIMER

This program is Copyright 2001 by Michael Erskine.
This program is free software; you can redistribute it and/or
modify it under the terms of the Perl Artistic License or the
GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any
later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

If you do not have a copy of the GNU General Public License write to
the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
MA 02139, USA.

=cut