You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
121 lines
2.0 KiB
Perl
121 lines
2.0 KiB
Perl
# $Id: Util.pm,v 1.1 2000/11/01 22:40:50 lenzo Exp $
|
|
|
|
use strict;
|
|
|
|
package Util;
|
|
|
|
=head1 NAME
|
|
|
|
Util - infobot utility functions
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
export_to_main qw(func &func2 $scalar @array %hash);
|
|
import_from_main qw(func &func2 $scalar @array %hash);
|
|
import_export $from_pkg, $to_pkg, @symbol;
|
|
|
|
process_args \@arg_list, myarg => \$myvar, %more_pairs or die;
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This module provides some utility functions for the B<infobot>.
|
|
|
|
=cut
|
|
|
|
use Carp qw(croak);
|
|
use Exporter ();
|
|
|
|
use vars qw($VERSION @ISA @EXPORT_OK);
|
|
|
|
$VERSION = do{my@r=q$Revision: 1.1 $=~/\d+/g;sprintf '%d.'.'%03d'x$#r,@r};
|
|
|
|
@ISA = qw(Exporter);
|
|
@EXPORT_OK = qw(
|
|
export_to_main
|
|
import_export
|
|
import_from_main
|
|
process_args
|
|
);
|
|
|
|
=head1 IMPORTABLE SYMBOLS
|
|
|
|
=over 4
|
|
|
|
=cut
|
|
|
|
sub import_export {
|
|
my ($from_pkg, $to_pkg, @symbol) = @_;
|
|
my ($symbol, $type, $name, $code);
|
|
|
|
$code = "package $to_pkg;\n";
|
|
for $symbol (@symbol) {
|
|
($type, $name) = $symbol =~ /^([\$\@%&])?(\w+)$/
|
|
or croak "Invalid symbol `$symbol'";
|
|
$type ||= '&';
|
|
$code .= "*$name = \\$type${from_pkg}::$name;\n";
|
|
}
|
|
print $code if 0;
|
|
|
|
{
|
|
no strict 'refs';
|
|
eval $code;
|
|
die if $@;
|
|
}
|
|
}
|
|
|
|
sub export_to_main {
|
|
my @symbol = @_;
|
|
import_export scalar(caller), 'main', @symbol;
|
|
}
|
|
|
|
sub import_from_main {
|
|
my @symbol = @_;
|
|
import_export 'main', scalar(caller), @symbol;
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
|
|
BEGIN {
|
|
import_from_main qw(status);
|
|
}
|
|
|
|
sub process_args {
|
|
my ($rarg, %desc) = @_;
|
|
|
|
my $caller_sub = (caller 1)[3];
|
|
my $fail = 0;
|
|
|
|
while (@$rarg > 1) {
|
|
my ($key, $val) = splice @$rarg, 0, 2;
|
|
if ($desc{$key}) {
|
|
${ $desc{$key} } = $val;
|
|
} else {
|
|
status "$caller_sub: invalid arg `$key'";
|
|
$fail = 1;
|
|
}
|
|
}
|
|
|
|
if (@$rarg) {
|
|
status "$caller_sub: ignoring trailing value-less arg `$rarg->[0]'";
|
|
$fail = 1;
|
|
}
|
|
|
|
return !$fail;
|
|
}
|
|
|
|
1
|
|
|
|
__END__
|
|
|
|
=back
|
|
|
|
=head1 AUTHOR
|
|
|
|
Roderick Schertler <F<roderick@argon.org>>
|
|
|
|
=head1 SEE ALSO
|
|
|
|
infobot(1), perl(1).
|
|
|
|
=cut
|