# BioMirror/Mirror.pm
# Bio-Mirror perl packages
# d.gilbert


=head1 NAME

BioMirror::Mirror  - mirror server base class

=head1 DESCRIPTION

Defines common variables and methods for BioMirror mirror servers.
Most variables are set by subclasses of this package/class.

See package BioMirror::Mirrors:: for subclasses.

=cut

package BioMirror::Mirror;

$VERSION = "1.0";
sub Version { $VERSION; }

use URI::URL;


sub isBioMirrorMirrorClass() { return 1; }

sub getSubclasses {
		## some perl tricks here
	%packhash= %BioMirror::;   
  foreach $symname (sort keys %packhash ) { 
  	local *sym= $packhash{$symname};
  	if (defined(%sym) && $symname =~ /::$/) {
  		my $classname= "BioMirror::$symname";
  		$classname =~ s/::$//;
  		next if ($classname eq 'BioMirror::Mirror'); ## skip this class
			my $ismyclass= $classname->can('isBioMirrorMirrorClass');
			if ($ismyclass) {
	  		## print "new  $classname \n" if $main::debug;
  			my $ob= new $classname;
  			push( @dataclasslist, $ob); 
  			}
  		}
  	}
}

sub elements() { 
	getSubclasses() unless(defined @dataclasslist);
	return @dataclasslist; 
}


sub new {
	my $that= shift;
	my $class= ref($that) || $that;
	my %fields = @_;  # convert into associative array
	my $self = \%fields;
	bless $self, $class;
	$self->init();
	return $self;
}


sub init {
	my $self= shift;
	$self->{name}= 'Bio-Mirror Mirror' unless (exists $self->{name} );
}

	

sub print {
	my $self= shift;
	foreach (sort keys %$self) { 
		print "$_ => ";
		my $val= $self->{$_};
		if (ref($val) =~ /HASH/) {
			foreach $k (sort keys %$val) { print "$k=>$$val{$k}\n"; } 
			}
		elsif (ref($val) =~ /ARRAY/ ) { print join(', ',@$val) ."\n"; }
		else { print "$val\n";  }
		}
}

sub toString {  ## java favorite
	my $self= shift;
	my $s= '%' . ref($self) . '= { ';
	foreach (sort keys %$self) { 
		$s .= "$_ => ";
		my $val= $self->{$_};
		if (ref($val) =~ /HASH/) {
			$s .=  '{'; 
			foreach $k (sort keys %$val) { $s .=  "$k=>\'$$val{$k}\', "; } 
			$s .=  '}, '; 
			}
		elsif (ref($val) =~ /ARRAY/ ) { $s .=  'qw[' . join(', ',@$val) .'], '; }
		else { $s .= "\'$val\', ";  }
		}
	$s .= ' }; ';
	return $s;
}


## sub packname { my $self= shift; return lc($self->{srsdb}); }


##  AUTOLOAD -- supply set/get methods for fields 
## change names to cleaner 'get'/'set' -- so can do getVariable(2) for array ref ?
sub AUTOLOAD {
	my $self= shift;
	my $type= ref($self);
	my $name= $AUTOLOAD;
	$name =~ s/.*://;  ## drop package prefix
	## unless (exists $self->{$name} ) { warn "Can't access $name field in class $type"; }
	
		## call now $obj->get_varname($x), $obj->set_varname($x)
		## OR  $obj->getVarname($x), $obj->setVarname($x)
	
	if ($name =~ /^get_?(.+)/) {
		my $var= lcfirst($1);
		my $rvar= $self->{$var};
		if (@_ && ref($rvar) =~ /ARRAY/) { return ${$rvar}[shift]; }
		else { return $rvar; }
		}
	elsif ($name =~ /^set_?(.+)/) {
		my $var= lcfirst($1);
		if (@_) { return $self->{$var}= shift;}
		else { return $self->{$var}= undef; }
		}

		## call was $obj->varname() -- this is perl semi-standard - support?
	elsif (@_) { return $self->{$name}= shift; }
	else { return $self->{$name}; }

}


sub DESTROY {
	my $self= shift;
	##warn "DESTROY $self";
}

#-------------

1; ## perly