NAME
Perlbug::Base - Module for bringing together Config, Log, Do(wrapper functions), Database, all Objects etc.
DESCRIPTION
Perlbug application interface, expected to be subclassed by actual interfaces, and/or used as configuration manager/reader.
see Perlbug::Interface::Cmd, Perlbug::Interface::Web etc.
SYNOPSIS
my $o_base = Perlbug::Base->new;
print "System maintainer contact: ".$o_base->system('maintainer');
print "Total bugs: ".$o_base->object('bug')->ids;
my $o_user = $o_base->object('user')->read('richard');
print 'User('.$o_user->attr('name').') data: '.$o_user->format('l');
METHODS
- new
-
Create new Perlbug object, (see also Description above):
my $o_base = Perlbug::Base->new();
Loading casualties from the log via tell_time():
[0] INIT (18214) scr(/usr/local/httpd/htdocs/perlbug/admin/perlbug.cgi), debug(01xX) Perlbug::Log=HASH(0x860ef1c) [1] Connect host(localhost), db(perlbug), user(perlbug), pass(sqlpassword) [2] Connected to perlbug: 42 tables [3] Perlbug 2.52 loaded 21 objects(@objects) Startup: 0 wallclock secs ( 0.10 usr + 0.00 sys = 0.10 CPU) Loaded : 0 wallclock secs ( 0.27 usr + 0.00 sys = 0.27 CPU) Runtime: 0 wallclock secs ( 0.06 usr + 0.00 sys = 0.06 CPU) Alltook: 0 wallclock secs ( 0.43 usr + 0.00 sys = 0.43 CPU) including 44 SQL statements
- init
-
Initialize Base object
my $self = $o_base->init;
- conf
-
Return Config object
my $o_conf = $o_base->conf;
- cgi
-
Get and set CGI->new object
- db
-
get database object
- log
-
get log object
- debug
-
Debug method, logs to "log_file", with configurable levels of tracking:
Controlled by
$ENV{'Perlbug_DEBUG'}
or $Perlbug::DEBUG or $o_base->current('debug')Note that current('debug') will always override any local setting, being as it purports to be the application debug level, unless it is set to an empty string => ' '
0 = login, interface, function (basic) (if debug =~ /\w+/) 1 = decisions (sets 01) 2 = data feedback from within methods (sets 012msX) 3 = more than you want (sets 0123mMsSxX) m = method names M = Method names (fully qualified) s = sql statements (num rows affected) S = SQL returns values (dump) x = execute statements (not SELECTs) X = EXecute returned n-results
- _debug
-
Quiet form of debug(), just calls the file method, and will never carp or confess, so the user generally won't see the contents of the message
- logg
-
Files args to log file
$o_base->logg('Done something');
- get_rand_msgid
-
Returns randomised recognisableid . processid . rand(time)
my $it = get_rand_msgid();
An alternative might be:
my $msgid = "<19870502_$$.$time.$count@rfi.net>";
- splice
-
Returns a given Mail::Internet object s(p)liced up into useful bits.
my ($o_hdr, $header, $body) = $self->splice($o_int); # todo ---sig
- object
-
Return appropriate (cached) object:
my $o_bug = $o_obj->object('Bug'); my $o_usr = $o_obj->object('User');
For a relationship, the correct syntax would, (though deprecated, unsupported and generally disparaged :), be of the form source->target eg;
my $o_bug_patch = $o_obj->object('bug->patch', '', 'to');
A relationship is taken care of by a special method: see Perlbug::Object::relation()
All Object know what relationships they have: see Perlbug::Object::relations()
etc.
- version
-
Get Perlbug::Version
my $vers = $o_base->version;
- isatest
-
Get and set isa test status
my $i_isatest = $o_base->isatest( [01] );
- summary
-
Return summary of open/closed bugs
print $o_web->summary();
- isframed
-
Simple wrapper
print "framed<hr>" if $o_base->isframed;
- myurl
-
Store and return the given url, with appropriate underscore '_'.
my $url = $o_base->myurl( $url );
- href
-
Cheat Wrapper for Object::href
- dodgy_addresses
-
Returns quotemeta'd, OR-d dodgy addresses prepared for a pattern match ...|...|...
my $regex = $o_obj->dodgy_addresses('from'); # $regex = 'perlbug\@perl\.com|perl5\-porters\@perl\.org|...'
- objects
-
Return list of names of objects in application, by type
my @objnames = $o_pb->objects('mail'); my @flags = $o_pb->objects('flag');
- flags
-
Returns array of options for given type.
my @list = $pb->flags('group');
- all_flags
-
Return all flags available in db keyed by type/ident.
my %flags = $pb->all_flags; %flags = ( # now looks like this: 'group' => ['core', 'docs', 'install'], # ... 'status' => ['open', 'onhold', 'closed'], # ... # ... );
- date_hash
-
Returns convenient date hash structure with sql query for values
my %dates = $o_base->date_hash; # 'this week' => 'TO_DAYS(SYSDATE()) - TO_DAYS(created) <= 7'
- help
-
Returns help message for perlbug database.
my $help = $pb->help;
- spec
-
Returns spec message for perlbug database.
print $pb->spec;
- check_user
-
Checks given user is registered in the database as an admin.
Sets userid in admin and thereby status for later reference.
$pb->check_user($user_name);
- isadmin
-
Returns current admin userid (post check_user), checks whether system is restricted or not.
print 'current user: '.$pb->isadmin; # name | ''
- isbugmaster
-
Returns current admin userid (post check_user), if base->isadmin eq base->system(bugmaster)
print 'is bugmaster: '.$pb->isbugmaster; # name | ''
- switches
-
Returns array of appropriate switches based on isadmin or arg.
my @switches = $o_pb->switches([admin|user]); # exlusive
- create_file
-
Create new file with this data:
$o_file = $self->create("$dir/$file.tmp", $data);
- prioritise
-
Set priority nicer by given integer, or by 12.
- set_user
-
Sets the given user to the runner of this script.
- read
-
First we look in site, then docs...
my @data = $o_base->read('header'); # or footer or mailhelp
- target2file
-
Return appropriate dir/file.ext for given target string
my $filename = $o_base->target2file('header'); # -> '~/text/header'
- clean_cache
-
Application objects/methods may call this to clean the sql and/or object cache, particularly useful when objects or their relationships are being created or deleted:
It will not do so while application cacheing is on unless used with the 'force' command.
See also cachable()
Returns self
my $o_obj = $o_obj->clean_cache([], [force]); # all (sql, objects, time) my $o_obj = $o_obj->clean_cache('sql', [force]); # just sql my $o_obj = $o_obj->clean_cache('object', [force]); # just objects
- get_list
-
Returns a simple list of items (column values?), from a sql query.
Optional second parameter overrides sql statement/result cacheing.
my @list = $pb->get_list('SELECT COUNT(bugid) FROM db_table', ['refresh']);
- get_data
-
Returns a list of hash references, from a sql query.
Optional second parameter overrides sql statement/result cacheing.
my @hash_refs = $pb->get_data('SELECT * FROM db_table', ['refresh']);
- exec
-
Returns statement handle from sql query.
my $sth = $pb->exec($sql);
- extant
-
Track bugids from this session
my @extant = $o_base->extant($bugid);
- exists
-
Does this bugid exist in the db?
- notify
-
Notify all relevant parties of incoming item
my $i_ok = $o_base->notify('bug', '19870502.007');
- setup_int
-
Setup Mail::Internet object from given args, body is default unless given.
my $o_int = $o_base->setup_int(\%header, [$body]); # 'to' => 'to@x.net'
or
my $o_int = $o_base->setup_int($db_header, [$body]); # could be folded
- notify_cc
-
Notify db_bug_address addresses of changes, given current/original status of bug.
my $i_ok = $o_base->notify_cc($bugid, $orig);
- track
-
Track some function or modification to the db.
$sth = $self->track($obj, $id, $entry);
- ck822
-
Email address checker (RFC822) courtesy Tom Christiansen/Jeffrey Friedl.
print (($o_email->ck822($addr)) ? "yup($addr)\n" : "nope($addr)\n");
- htpasswd
-
Modify, add, delete, comment out entries in .htpasswd
$i_ok = $o_web->htpasswd($userid, $pass); # entry ok? @entries = $o_web->htpasswd; # returns list of entries ('userid:passwd', 'user2:pass2'...)
- help_ref
-
Creates something of the form:
<a href="http://bugs.per.org/perlbug.cgi?req=webhelp\#item_note"
Note</a>>my $help = $self->help_ref('note', ['Note HELP']);
- clean_up
-
Clean up previous logs activity whenever run, and report briefly on how long this process took.
Exits when done.
- tell_time
-
Put runtime info in log file, if $Perlbug::DEBUG
my $feedback = $o_base->tell_time(Benchmark->new);
- parse_str
-
Returns hash of data extracted from given string.
Matches are 'nearest wins' after 4 places ie; clos=closed.
NB. Will catch userids when i_int=userid, userid->name, name->fullname
my %cmds = $o_obj->parse_str('5.0.5_444_aix_irix_<bugid>_etc' | (qw(patchid bugid etc)); %cmds = ( 'bugids' => \@bugids, 'change' => { 'ids' => [qw(3)], 'names' => [qw(553)], }, 'osname' => { 'ids' => [qw(12 14)], 'names' => [qw(aix macos irix)], }, 'unknown' => { 'ids' => [qw(0123456789)], 'names' => [qw(etc)], }, );
- scan
-
Scan for perl relevant data putting found or default switches in $h_data.
Looking for both group=docs and '\brunning\s*under\ssome\s*perl' style markers.
my $h_data = $o_mail->scan($body);
Migrate to return parse_str() style hashref
- bugid_2_addresses
-
Return addresses based on context
my @addrs = $o_email->bugid_2_addresses($bugid);
- compare
-
Compare two arrays: returns 1 if identical, 0 if not.
my $identical = compare(\@arry1, \@arry2); # tomc
AUTHOR
Richard Foley perlbug@rfi.net 1999 2000 2001