~ubuntu-branches/ubuntu/quantal/libglib-perl/quantal : revision 12

1

#

2

#

3

#

4

# TODO:

5

# should we look at signals etc. for enums/flags?

6

# we're getting warnings about unregistered types with new enums/flags

7

# stuff, quell them.

8

#

9

10

package Glib::GenPod;

11

12

our $VERSION = '0.03';

13

14

use strict;

15

use warnings;

16

use Carp;

17

use File::Spec;

18

use Data::Dumper;

19

use POSIX qw(strftime);

20

21

use Glib;

22

23

use base 'Exporter';

24

25

our @EXPORT = qw(

26

add_types

27

xsdoc2pod

28

podify_properties

29

podify_child_properties

30

podify_style_properties

31

podify_values

32

podify_signals

33

podify_ancestors

34

podify_interfaces

35

podify_methods

36

podify_enums_and_flags

37

podify_deprecated_by

38

);

39

40

our $COPYRIGHT = undef;

41

our $AUTHORS = 'Gtk2-Perl Team';

42

our $MAIN_MOD = undef;

43

our $YEAR = strftime "%Y", gmtime;

44

45

our ($xspods, $data);

46

47

=head1 NAME

48

49

Glib::GenPod - POD generation utilities for Glib-based modules

50

51

=head1 SYNOPSIS

52

53

use Glib::GenPod;

54

55

# use the defaults:

56

xsdoc2pod ($xsdocparse_output_file, $destination_dir);

57

58

# or take matters into your own hands

59

require $xsdocparse_output_file;

60

foreach my $package (sort keys %$data) {

61

print "=head1 NAME\n\n$package\n\n";

62

print "=head1 METHODS\n\n" . podify_methods ($package) . "\n\n";

63

}

64

65

=head1 DESCRIPTION

66

67

This module includes several utilities for creating pod for xs-based Perl

68

modules which build on the Glib module's foundations. The most important bits

69

are the logic to convert the data structures created by xsdocparse.pl to

70

describe xsubs and pods into method docs, with call signatures and argument

71

descriptions, and converting C type names into Perl type names. The rest of

72

the module is mostly boiler-plate code to format and pretty-print information

73

that may be queried from the Glib type system.

74

75

To make life easy for module maintainers, we also include a do-it-all function,

76

xsdoc2pod(), which does pretty much everything for you. All of the pieces it

77

uses are publically usable, so you can do whatever you like if you don't like

78

the default output.

79

80

=head1 DOCUMENTING THE XS FILES

81

82

All of the information used as input to the methods included here comes from

83

the XS files of your project, and is extracted by Glib::ParseXSDoc's

84

C<xsdocparse>. This function creates an file containing Perl code that may be

85

eval'd or require'd to recreate the parsed data structures, which are a list of

86

pods from the verbatim C portion of the XS file (the xs api docs), and a hash

87

of the remaining data, keyed by package name, and including the pods and xsubs

88

read from the rest of each XS file following the first MODULE line.

89

90

Several custom POD directives are recognized in the XSubs section. Note that

91

each one is sought as a paragraph starter, and must follow a C<=cut> directive.

92

93

=over

94

95

=item =for object Package::Name

96

97

All xsubs and pod from here until the next object directive or MODULE line

98

will be placed under the key 'I<Package::Name>' in xsdocparse's data

99

structure. Everything from this line to the next C<=cut> is included as a

100

description POD.

101

102

=item =for object Package::Name (Other::Package::Name)

103

104

Generate POD in I<Package::Name> but for the package I<Other::Package::Name>.

105

This is useful if you want POD to appear in a different namespace but still

106

want the automatically generated hierarchy, signal and property listing,

107

etc. from the original namespace. For example:

108

109

=for object Gnome2::PanelApplet::main (Gnome2::PanelApplet)

110

=cut

111

112

This will create Gnome2/PanelApplet/main.pod containing the automatically

113

generated documentation for Gnome2::PanelApplet (hierarchy, signals, etc.) plus

114

the method listing from the current XS file.

115

116

=item =for enum Package::Name

117

118

=item =for flags Package::Name

119

120

This causes xsdoc2pod to call C<podify_values> on I<Package::Name> when

121

writing the pod for the current package (as set by an object directive or

122

MODULE line). Any text in this paragraph, to the next C<=cut>, is included

123

in that section.

124

125

=item =for deprecated_by Package::Name

126

127

Used to add a deprecation warning, indicating I<Package::Name> as an

128

alternative way to achieve the same functionality. There may be any number

129

these in each package.

130

131

=item =for see_also L<some_thing_to_see>

132

133

Used to add extra see alsos onto the end of the parents, if any, for a given

134

object. Anything following the space behind see_also up to the end of the

135

line will be placed onto the list of "see also"s. There may be any number of

136

these in each package.

137

138

=item =for apidoc

139

140

=item =for apidoc Full::Symbol::name

141

142

Paragraphs of this type document xsubs, and are associated with the xsubs

143

by xsdocparse.pl. If the full symbol name is not included, the paragraph

144

must be attached to the xsub declaration (no blank lines between C<=cut> and

145

the xsub).

146

147

Within the apidoc PODs, we recognize a few special directives (the "for\s+"

148

is optional on these):

149

150

=over

151

152

=item =for signature ...

153

154

Override the generated call signature with the ... text. If you include

155

multiple signature directives, they will all be used. This is handy when

156

you want to change the return type or list different ways to invoke an

157

overloaded method, like this:

158

159

=for apidoc

160

161

=signature bool Class->foo

162

163

=signature ($thing, @other) = $object->foo ($it, $something)

164

165

Text in here is included in the generated documentation.

166

You can actually include signature and arg directives

167

at any point in this pod -- they are stripped after.

168

In fact, any pod is valid in here, until the =cut.

169

170

=cut

171

void foo (...)

172

PPCODE:

173

/* crazy code follows */

174

175

=item =for arg name (type) description

176

177

=item =for arg name description

178

179

The arg directive adds or overrides an argument description. The

180

description text is optional, as is the type specification (the part

181

in parentheses). If you want to hide an argument, specify C<__hide__>

182

as its type. The arg name does I<not> need to include a sigil,

183

as dollar signs will be added. FIXME what about @ for lists?

184

185

=back

186

187

Also, we honor a couple of "modifiers" on the =for apidoc line, following the

188

symbol name, if present:

189

190

=over

191

192

=item - __hide__

193

194

Do not document this xsub. This is handy in certain situations, e.g., for

195

private functions. DESTROY always has this turned on, for example.

196

197

=item - __gerror__

198

199

This function or method can generate a Glib::Error exception.

200

201

=item - __function__

202

203

Generate a function-style signature for this xsub. The default is to

204

generate method-style signatures.

205

206

=item - __deprecated__

207

208

This function or method is deprecated and should not be used in newly written

209

code.

210

211

=back

212

213

(These are actually handled by Glib::ParseXSDoc, but we list them here

214

because, well, they're an important part of how you document the XS files.)

215

216

=back

217

218

=head1 FUNCTIONS

219

220

=over

221

222

=cut

223

224

=item xsdoc2pod ($datafile, $outdir='blib/lib', index=undef)

225

226

Given a I<$datafile> containing the output of xsdocparse.pl, create in

227

I<$outdir> a pod file for each package, containing everything we can think

228

of for that module. Output is controlled by the C<=for object> directives

229

and such in the source code.

230

231

If you don't want each package to create a separate pod file, then use

232

this function's code as a starting point for your own pretty-printer.

233

234

=cut

235

236

sub xsdoc2pod

237

{

238

my $datafile = shift();

239

my $outdir = shift() || 'blib/lib';

240

my $index = shift;

241

242

mkdir $outdir unless (-d $outdir);

243

244

die "usage: $0 datafile [outdir]\n"

245

unless defined $datafile;

246

247

require $datafile;

248

249

my @files = ();

250

251

my $pkgdata;

252

my $ret;

253

254

foreach my $package (sort { ($a->isa('Glib::Object') ? -1 : 1) }

255

keys %$data)

256

{

257

$pkgdata = $data->{$package};

258

259

my $pod = File::Spec->catfile ($outdir, split /::/, $package)

260

. '.pod';

261

my (undef, @dirs, undef) = File::Spec->splitpath ($pod);

262

mkdir_p (File::Spec->catdir (@dirs));

263

264

open POD, ">$pod" or die "can't open $pod for writing: $!\n";

265

select POD;

266

267

$package = $pkgdata->{object} if (exists $pkgdata->{object});

268

269

preprocess_pod ($_) foreach (@{$pkgdata->{pods}});

270

271

push @files, {

272

name => $package,

273

file => $pod,

274

blurb => $pkgdata->{blurb},

275

};

276

277

# podify_pods() always returns proper POD with a =cut at the

278

# end. But all the other =head1 below need a closing =cut.

279

280

print "=head1 NAME\n\n$package";

281

if(exists ($pkgdata->{blurb})) {

282

print ' - '.$pkgdata->{blurb};

283

} elsif($package =~ m/^Gtk2::Pango/) {

284

my $newname = $package;

285

$newname =~ s/Gtk2:://;

286

print ' - moved to ' . $newname . ', kept for backwards compatibility'

287

} elsif(convert_to_cname($package)) {

288

print ' - wrapper for '.convert_to_cname($package);

289

}

290

print "\n\n=cut\n\n";

291

292

# pods , position

293

$ret = podify_pods ($pkgdata->{pods}, 'SYNOPSIS');

294

print "$ret\n\n" if ($ret);

295

296

$ret = podify_pods ($pkgdata->{pods}, 'DESCRIPTION');

297

print "$ret\n\n" if ($ret);

298

299

my $parents;

300

($ret, $parents) = podify_ancestors ($package);

301

print "=head1 HIERARCHY\n\n$ret\n\n=cut\n\n" if ($ret);

302

303

$ret = podify_pods ($pkgdata->{pods}, 'post_hierarchy');

304

print "$ret\n\n" if ($ret);

305

306

$ret = podify_interfaces ($package);

307

print "=head1 INTERFACES\n\n$ret\n\n=cut\n\n" if ($ret);

308

309

$ret = podify_pods ($pkgdata->{pods}, 'post_interfaces');

310

print "$ret\n\n" if ($ret);

311

312

$ret = podify_pods ($pkgdata->{pods});

313

print "$ret\n\n" if ($ret);

314

315

$ret = podify_deprecated_by ($package, @{ $pkgdata->{deprecated_bys} });

316

print "\n=head1 DEPRECATION WARNING\n\n$ret\n\n=cut\n\n" if ($ret);

317

318

$ret = podify_methods ($package, $pkgdata->{xsubs});

319

print "\n=head1 METHODS\n\n$ret\n\n=cut\n\n" if ($ret);

320

321

$ret = podify_pods ($pkgdata->{pods}, 'post_methods');

322

print "$ret\n\n" if ($ret);

323

324

$ret = podify_properties ($package);

325

print "\n=head1 PROPERTIES\n\n$ret\n\n=cut\n\n" if ($ret);

326

327

$ret = podify_child_properties ($package);

328

print "\n=head1 CHILD PROPERTIES\n\n$ret\n\n=cut\n\n" if ($ret);

329

330

$ret = podify_style_properties ($package);

331

print "\n=head1 STYLE PROPERTIES\n\n$ret\n\n=cut\n\n" if ($ret);

332

333

$ret = podify_pods ($pkgdata->{pods}, 'post_properties');

334

print "$ret\n\n" if ($ret);

335

336

$ret = podify_signals ($package);

337

print "\n=head1 SIGNALS\n\n$ret\n\n=cut\n\n" if ($ret);

338

339

$ret = podify_pods ($pkgdata->{pods}, 'post_signals');

340

print "$ret\n\n" if ($ret);

341

342

$ret = podify_enums_and_flags ($pkgdata, $package);

343

print "\n=head1 ENUMS AND FLAGS\n\n$ret\n\n=cut\n\n" if ($ret);

344

345

$ret = podify_pods ($pkgdata->{pods}, 'post_enums');

346

print "$ret\n\n" if ($ret);

347

348

$ret = podify_pods ($pkgdata->{pods}, 'SEE_ALSO');

349

if ($ret)

350

{

351

print "$ret\n\n";

352

}

353

else

354

{

355

# don't link to yourself

356

pop @$parents;

357

# link to the toplevel, if we can.

358

unshift @$parents, $MAIN_MOD if $MAIN_MOD;

359

360

$ret = podify_see_alsos (@$parents,

361

$pkgdata->{see_alsos}

362

? @{ $pkgdata->{see_alsos} }

363

: ());

364

print "\n=head1 SEE ALSO\n\n$ret\n\n=cut\n\n" if ($ret);

365

}

366

367

$ret = podify_pods ($pkgdata->{pods}, 'COPYRIGHT');

368

if ($ret)

369

{

370

# copyright over-ridden

371

print "$ret\n\n"

372

}

373

else

374

{

375

# use normal copyright system

376

$ret = get_copyright ();

377

print "\n=head1 COPYRIGHT\n\n$ret\n\n=cut\n\n" if ($ret);

378

}

379

380

close POD;

381

}

382

383

if ($index) {

384

open INDEX, ">$index"

385

or die "can't open $index for writing: $!\b";

386

select INDEX;

387

388

foreach (sort {$a->{name} cmp $b->{name}} @files) {

389

print join("\t", $_->{file},

390

$_->{name},

391

$_->{blurb} ? $_->{blurb} : () ) . "\n";

392

}

393

394

close INDEX;

395

}

396

}

397

398

# more sensible names for the basic types

399

our %basic_types = (

400

# the perl wrappers for the GLib fundamentals

401

'Glib::Scalar' => 'scalar',

402

'Glib::String' => 'string',

403

'Glib::Int' => 'integer',

404

'Glib::Uint' => 'unsigned',

405

'Glib::Double' => 'double',

406

'Glib::Float' => 'float',

407

'Glib::Boolean' => 'boolean',

408

409

# sometimes we can get names that are already mapped...

410

# e.g., from =for arg lines. pass them unbothered.

411

scalar => 'scalar',

412

subroutine => 'subroutine',

413

integer => 'integer',

414

string => 'string',

415

package => 'package',

416

list => 'list',

417

418

# other C names which may sneak through

419

bool => 'boolean', # C++ keyword, but provided by the perl api

420

boolean => 'boolean',

421

int => 'integer',

422

char => 'integer',

423

uint => 'unsigned',

424

float => 'double',

425

double => 'double',

426

char => 'string',

427

unsigned => 'unsigned',

428

429

gboolean => 'boolean',

430

gint => 'integer',

431

gint8 => 'integer',

432

gint16 => 'integer',

433

gint32 => 'integer',

434

guint8 => 'unsigned',

435

guint16 => 'unsigned',

436

guint32 => 'unsigned',

437

glong => 'integer',

438

gulong => 'unsigned',

439

gshort => 'integer',

440

guint => 'integer',

441

gushort => 'unsigned',

442

gint64 => '64 bit integer',

443

guint64 => '64 bit unsigned',

444

gfloat => 'double',

445

gdouble => 'double',

446

gsize => 'unsigned',

447

gssize => 'integer',

448

goffset => '64 bit integer',

449

gchar => 'string',

450

451

SV => 'scalar',

452

UV => 'unsigned',

453

IV => 'integer',

454

CV => 'subroutine',

455

AV => 'arrayref',

456

457

gchar_length => 'string',

458

gchar_utf8_length => 'string',

459

460

FILE => 'file handle',

461

time_t => 'unix timestamp',

462

463

GPerlFilename => 'localized file name',

464

GPerlFilename_const => 'localized file name',

465

);

466

467

unless (Glib->CHECK_VERSION (2, 4, 0)) {

468

$basic_types{'Glib::Strv'} = 'ref to array of strings';

469

}

470

471

=item add_types (@filenames)

472

473

Parse the given I<@filenames> for entries to add to the C<%basic_types> used

474

for C type name to Perl package name mappings of types that are not registered

475

with the Glib type system. The file format is dead simple: blank lines are

476

ignored; /#.*$/ is stripped from each line as comments; the first token on

477

each line is considered to be a C type name, and the remaining tokens are the

478

description of that type. For example, a valid file may look like this:

479

480

# a couple of special types

481

FooBar Foo::Bar

482

Frob localized frobnicator

483

484

C type decorations such as "const" and "*" are implied (do not include them),

485

and the _ornull variant is handled for you.

486

487

=cut

488

489

sub add_types {

490

my @files = @_;

491

foreach my $f (@files) {

492

open IN, $f or die "can't open types file $f: $!\n";

493

my $n = 0;

494

while (<IN>) {

495

chomp;

496

s/#.*//;

497

next if m/^\s*$/;

498

my ($c_name, @bits) = split;

499

if (@bits) {

500

$basic_types{$c_name} = join ' ', @bits;

501

$n++;

502

} else {

503

warn "$f:$.: no description for $c_name\n"

504

}

505

}

506

print "Loaded $n extra types from $f\n";

507

close IN;

508

}

509

}

510

511

512

=item $string = podify_properties ($packagename)

513

514

Pretty-print the object properties owned by the Glib::Object derivative

515

I<$packagename> and return the text as a string. Returns undef if there

516

are no properties or I<$package> is not a Glib::Object.

517

518

=cut

519

520

sub podify_properties {

521

my $package = shift;

522

my @properties;

523

eval { @properties = Glib::Object::list_properties($package); 1; }

524

|| return undef;

525

return _podify_pspecs($package, @properties);

526

}

527

528

sub _podify_pspecs {

529

my ($package, @properties) = @_;

530

return undef unless (@properties);

531

532

# we have a non-zero number of properties, but there may still be

533

# none for this particular class. keep a count of how many

534

# match this class, so we can return undef if there were none.

535

my $nmatch = 0;

536

my $str = "=over\n\n";

537

foreach my $p (sort { $a->{name} cmp $b->{name} } @properties) {

538

next unless $p->{owner_type} eq $package;

539

++$nmatch;

540

my $stat = join " / ", @{ $p->{flags} };

541

my $type = exists $basic_types{$p->{type}}

542

? $basic_types{$p->{type}}

543

: $p->{type};

544

my $default = _pspec_formatted_default($p);

545

$str .= "=item '$p->{name}' ($type : default $default : $stat)\n\n";

546

$str .= "$p->{descr}\n\n" if (exists ($p->{descr}));

547

}

548

$str .= "=back\n\n";

549

550

return $nmatch ? $str : undef;

551

}

552

553

# return a POD string which is the default value of $pspec, nicely formatted

554

sub _pspec_formatted_default {

555

my ($pspec) = @_;

556

my $default = $pspec->get_default_value;

557

if (! defined $default) {

558

return 'undef';

559

}

560

my $pname = $pspec->get_name;

561

my $type = $pspec->get_value_type;

562

563

# Crib: "eq" here because Glib::Boolean->isa('Glib::Boolean') is false,

564

# it's not an actual perl module

565

if ($type eq 'Glib::Boolean') {

566

$default = ($default ? 'true' : 'false');

567

568

} elsif ($type->isa('Glib::Flags')) {

569

$default = join ",", @$default;

570

571

} elsif ($pspec->isa('Glib::Param::Unichar')) {

572

# $default is a single-char string, show as ordinal and string.

573

# $type is only Glib::UInt, so this must be before plain UInts below.

574

# Eg. Gtk2::Entry property "invisible-char".

575

$default = ord($default) . ' ' . Data::Dumper->new([$default])

576

->Useqq(1)->Terse(1)->Indent(0)->Dump;

577

578

} elsif ($type eq 'Glib::Double' && $default == POSIX::DBL_MAX()) {

579

# Show DBL_MAX symbolically.

580

# Eg. Gtk2::Range property "fill-level" is DBL_MAX.

581

$default = "DBL_MAX";

582

} elsif ($type eq 'Glib::Double' && $default == - POSIX::DBL_MAX()) {

583

$default = "-DBL_MAX";

584

} elsif ($type eq 'Glib::Float' && $default == POSIX::FLT_MAX()) {

585

$default = "FLT_MAX";

586

} elsif ($type eq 'Glib::Float' && $default == - POSIX::FLT_MAX()) {

587

$default = "-FLT_MAX";

588

589

} elsif ($type eq 'Glib::Double' || $type eq 'Glib::Float') {

590

# Limit the decimals shown in floats,

591

# eg. Gtk2::Menu style property "arrow-scaling" is 0.7 and comes out as

592

# 0.6999999999 if not restricted a bit

593

$default = sprintf '%.6g', $default;

594

595

} elsif ($pname =~ /keyval/

596

&& $type eq 'Glib::UInt'

597

&& eval { require Gtk2; 1 }) {

598

# Keyvals in hex the same as gdkkeysyms.h, and show the symbol if known.

599

# The pspec type of keyvals is only UInt, must guess from the property

600

# name whether a uint is in fact a keyval.

601

# eg. Gtk2::Label property "mnemonic-keyval" is 0xFFFFFF=VoidSymbol

602

my $keyname = Gtk2::Gdk->keyval_name ($default);

603

$default = sprintf '0x%02X', $default; # two or more hex digits

604

if (defined $keyname) {

605

$default = "$default $keyname";

606

}

607

608

} elsif ($type eq 'Glib::Int' && $default == POSIX::INT_MAX()) {

609

# Show INT_MAX symbolically

610

# eg. Gtk2::Paned property "max-position" is INT_MAX

611

$default = "INT_MAX";

612

} elsif ($type eq 'Glib::Int' && $default == POSIX::INT_MIN()) {

613

$default = "INT_MAX";

614

} elsif ($type eq 'Glib::UInt' && $default == POSIX::UINT_MAX()) {

615

$default = "UINT_MAX";

616

617

} else {

618

# Strings quoted for clarity, unprintables shown backslashed

619

# eg. Gtk2::UIManager property "ui" has newlines

620

# eg. Gtk2::TreeView style property "tree-line-pattern" is bytes "\001\001"

621

$default = Data::Dumper->new([$default])

622

->Useqq(1)->Terse(1)->Indent(0)->Dump;

623

}

624

625

# Escape "<" to E<lt> etc.

626

# eg. Gtk2::UIManager property "ui" is "<ui></ui>"

627

$default = _pod_escape($default);

628

629

return $default;

630

}

631

632

# Return $str with characters escaped ready to appear in pod. This means

633

# non-ascii escaped to E<123> and "<" to E<lt>. Strictly speaking "<" only

634

# has to be escaped if it would be B<... etc, but it's easier to do it

635

# always and might help some of the pod formatters. $str is assumed to have

636

# no non-printables (control chars etc).

637

# (ENHANCE-ME: Is there a module to do char->pod like this? Pod::Escapes is

638

# the converse pod->char ...)

639

sub _pod_escape {

640

my ($str) = @_;

641

$str =~ s{([^[:ascii:]])|(<)}

642

{defined $1 ? ('E<'.ord($1).'>') : 'E<lt>'}eg;

643

return $str;

644

}

645

646

=item $string = podify_child_properties ($packagename)

647

648

Pretty-print the child properties owned by the Gtk2::Container derivative

649

I<$packagename> and return the text as a string. Returns undef if there are

650

no child properties or I<$package> is not a Gtk2::Container or similar class

651

with a C<list_child_properties()> method.

652

653

=cut

654

655

sub podify_child_properties {

656

my ($package) = shift;

657

# Call list_child_properties() as a method so as to perhaps work on

658

# Goo::Canvas::Item which has a similar child properties scheme of

659

# its own (it's not a Gtk2::Container subclass), though that method

660

# is not wrapped as of Goo::Canvas 0.06.

661

if ($package->can('list_child_properties')) {

662

return _podify_pspecs($package, $package->list_child_properties);

663

} else {

664

return undef;

665

}

666

}

667

668

=item $string = podify_style_properties ($packagename)

669

670

Pretty-print the style properties owned by the Gtk2::Widget derivative

671

I<$packagename> and return the text as a string. Returns undef if there are

672

no style properties or I<$package> is not a Gtk2::Widget or similar class

673

with a C<list_style_properties()> method.

674

675

=cut

676

677

sub podify_style_properties {

678

my ($package) = shift;

679

my @properties;

680

if ($package->can('list_style_properties')) {

681

return _podify_pspecs($package, $package->list_style_properties);

682

} else {

683

return undef;

684

}

685

}

686

687

=item $string = podify_values ($packagename)

688

689

List and pretty-print the values of the GEnum or GFlags type I<$packagename>,

690

and return the text as a string. Returns undef if I<$packagename> isn't an

691

enum or flags type.

692

693

=cut

694

695

sub podify_values {

696

my $package = shift;

697

my @values;

698

eval { @values = Glib::Type->list_values ($package); 1; };

699

return undef unless (@values or not $@);

700

701

return "=over\n\n"

702

. join ("\n\n", map { "=item * '$_->{nick}' / '$_->{name}'" } @values)

703

. "\n\n=back\n\n";

704

}

705

706

=item $string = podify_signals ($packagename)

707

708

Query, list, and pretty-print the signals associated with I<$packagename>.

709

Returns the text as a string, or undef if there are no signals or

710

I<$packagename> is not a Glib::Object derivative.

711

712

=cut

713

714

sub podify_signals {

715

my $str = undef;

716

eval {

717

my @sigs = Glib::Type->list_signals (shift);

718

return undef unless @sigs;

719

$str = "=over\n\n";

720

foreach (@sigs) {

721

$str .= '=item ';

722

$str .= convert_type ($_->{return_type}).' = '

723

if exists $_->{return_type};

724

$str .= "B<$_->{signal_name}> (";

725

$str .= join ', ', map { convert_type ($_) }

726

$_->{itype}, @{$_->{param_types}};

727

$str .= ")\n\n";

728

}

729

$str .= "=back\n\n";

730

};

731

return $str

732

}

733

734

=item $string = podify_deprecated_by ($packagename, @deprecated_by)

735

736

Creates a deprecation warning for $packagename, suggesting using the items

737

inside @deprecated_by instead.

738

739

=cut

740

741

sub podify_deprecated_by

742

{

743

my $package = shift;

744

my @deprecated_by = @_;

745

746

return undef unless scalar @deprecated_by;

747

748

my $str = "$package has been marked as deprecated, and should not be "

749

. "used in newly written code.\n\n";

750

751

# create the deprecated for list

752

$str .= "You should use "

753

. join (', ',

754

map {

755

if (/^\s*L</) {

756

$_;

757

}

758

else {

759

"L<$_>";

760

}

761

} @deprecated_by)

762

. " instead of $package.\n";

763

764

return $str;

765

}

766

767

sub podify_enums_and_flags

768

{

769

my $pkgdata = shift;

770

my $package = shift;

771

772

my %types = ();

773

774

my $name;

775

my $pod;

776

my %info = ();

777

foreach (@{$pkgdata->{enums}})

778

{

779

$name = convert_type ($_->{name});

780

781

$pod = $_->{pod};

782

shift @{ $pod->{lines} };

783

pop @{ $pod->{lines} } if $pod->{lines}[-1] =~ /^=cut/;

784

785

$info{$name} = {

786

type => $_->{type},

787

pod => $pod->{lines},

788

};

789

$types{$name}++;

790

}

791

792

foreach my $xsub (@{$pkgdata->{xsubs}})

793

{

794

if ($xsub->{return_type})

795

{

796

foreach my $ret (@{$xsub->{return_type}})

797

{

798

$name = convert_type ($ret);

799

$types{$name}++;

800

}

801

}

802

if ($xsub->{args})

803

{

804

foreach my $arg (@{$xsub->{args}})

805

{

806

if ($arg->{type})

807

{

808

$name = convert_type ($arg->{type});

809

$types{$name}++;

810

}

811

}

812

}

813

}

814

815

if ($package)

816

{

817

my @props;

818

eval { @props = Glib::Object::list_properties($package); 1; };

819

foreach my $prop (@props)

820

{

821

next unless ($prop->{type});

822

next unless $prop->{owner_type} eq $package;

823

$name = convert_type ($prop->{type});

824

$types{$name}++;

825

}

826

827

my @sigs;

828

eval { @sigs = Glib::Type->list_signals ($package); 1; };

829

foreach my $sig (@sigs)

830

{

831

if ($sig->{return_type})

832

{

833

$name = convert_type ($sig->{return_type});

834

$types{$name}++;

835

}

836

foreach (@{$sig->{param_types}})

837

{

838

next unless ($_);

839

$name = convert_type ($_);

840

$types{$name}++;

841

}

842

}

843

}

844

845

my $ret = '';

846

foreach (sort keys %types)

847

{

848

s/\s.*//;

849

850

next if $_ eq 'Glib::Enum' || $_ eq 'Glib::Flags';

851

852

my $values_pod = podify_values ($_);

853

854

if ($values_pod || exists $info{$_})

855

{

856

my $type = UNIVERSAL::isa ($_, 'Glib::Flags') ?

857

'flags' : 'enum';

858

$ret .= "=head2 $type $_\n\n";

859

$ret .= join ("\n", @{$info{$_}{pod}}) . "\n\n"

860

if ($info{$_}{pod});

861

$ret .= podify_values ($_) . "\n";

862

}

863

}

864

865

return $ret;

866

}

867

868

869

=item $string = podify_pods ($pods, $position)

870

871

Helper function to allow specific placement of generic pod within the auto

872

generated pages. Pod sections starting out with =for position XXX, where XXX

873

is one of the following will be placed at a specified position. In the case of

874

pod that is to be placed after a particular section that doesn't exist, that

875

pod will be still be placed there.

876

877

This function is called at all of the specified points through out the process

878

of generating pod for a page. Any pod matching the I<position> passed will be

879

returned, undef if no matches were found. If I<position> is undef all pods

880

without sepcific postion information will be returned. I<pods> is a reference

881

to an array of pod hashes.

882

883

=over

884

885

=item * SYNOPSIS

886

887

After the NAME section

888

889

=item * DESCRIPTION

890

891

After the SYNOPSIS section.

892

893

=item * post_hierarchy

894

895

After the HIERARCHY section.

896

897

=item * post_interfaces

898

899

After the INTERFACE section.

900

901

=item * post_methods

902

903

After the METHODS section.

904

905

=item * post_properties

906

907

After the PROPERTIES section.

908

909

=item * post_signals

910

911

After the SIGNALS section.

912

913

=item * post_enums

914

915

After the ENUMS AND FLAGS section.

916

917

=item * SEE_ALSO

918

919

Replacing the autogenerated SEE ALSO section completely.

920

921

=item * COPYRIGHT

922

923

Replacing the autogenerated COPYRIGHT section completely.

924

925

=back

926

927

=cut

928

929

sub podify_pods

930

{

931

my $pods = shift;

932

my $position = shift;

933

934

my $ret = '';

935

936

if ($position)

937

{

938

foreach (@$pods)

939

{

940

$ret .= join ("\n", @{$_->{lines}})."\n\n"

941

if (exists ($_->{position}) and

942

$_->{position} eq $position);

943

}

944

}

945

else

946

{

947

foreach (@$pods)

948

{

949

$ret .= join ("\n", @{$_->{lines}})."\n\n"

950

unless ($_->{position});

951

}

952

}

953

return $ret ne '' ? $ret : undef;

954

}

955

956

=item $string = podify_ancestors ($packagename)

957

958

Pretty-prints the ancestry of I<$packagename> from the Glib type system's

959

point of view. This uses Glib::Type->list_ancestors; see that function's

960

docs for an explanation of why that's different from looking at @ISA.

961

962

Returns the new text as a string, or undef if I<$packagename> is not a

963

registered GType.

964

965

=cut

966

967

sub podify_ancestors {

968

my @anc;

969

eval { @anc = Glib::Type->list_ancestors (shift); 1; };

970

return undef unless (@anc or not $@);

971

972

my $parents = [ reverse @anc ];

973

974

my $depth = 0;

975

my $str = ' '.pop(@anc)."\n";

976

foreach (reverse @anc) {

977

$str .= " " . " "x$depth . "+----$_\n";

978

$depth++;

979

}

980

$str .= "\n";

981

982

return ($str, $parents);

983

}

984

985

=item $string = podify_interfaces ($packagename)

986

987

Pretty-print the list of GInterfaces that I<$packagename> implements.

988

Returns the text as a string, or undef if the type implements no interfaces.

989

990

=cut

991

992

sub podify_interfaces {

993

my @int;

994

eval { @int = Glib::Type->list_interfaces (shift); 1; };

995

return undef unless (@int or not defined ($@));

996

return ' '.join ("\n ", @int)."\n\n";

997

}

998

999

=item $string = podify_methods ($packagename)

1000

1001

Call C<xsub_to_pod> on all the xsubs under the key I<$packagename> in the

1002

data extracted by xsdocparse.pl.

1003

1004

Returns the new text as a string, or undef if there are no xsubs in

1005

I<$packagename>.

1006

1007

=cut

1008

1009

sub podify_methods

1010

{

1011

my $package = shift;

1012

my $xsubs = shift;

1013

return undef unless $xsubs && @$xsubs;

1014

# we will be re-using $package from here on out.

1015

1016

my $str = '';

1017

my $nfound = 0;

1018

my $nused = 0;

1019

my $method;

1020

1021

# based on rm's initial thought and then code/ideas by Marc 'HE'

1022

# Brockschmidt, and Peter Haworth

1023

@$xsubs = sort {

1024

my ($at, $bt);

1025

for ($at=$a->{symname}, $bt=$b->{symname})

1026

{

1027

# remove prefixes

1028

s/^.+:://;

1029

# new's goto the front

1030

s/^new/\x00/;

1031

# group set's/get'ss

1032

s/^(get|set)_(.+)/$2_$1/;

1033

# put \<set\>'s with \<get\>'s

1034

s/^(get|set)$/get_$1/;

1035

}

1036

# now actually do the sorting compare

1037

$at cmp $bt;

1038

} @$xsubs;

1039

1040

#$str .= "=over\n\n";

1041

foreach (@$xsubs) {

1042

# skip if the method is hidden

1043

next if ($_->{hidden});

1044

1045

$_->{symname} =~ m/^(?:([\w:]+)::)?([\w]+)$/;

1046

$package = $1 || $_->{package};

1047

$method = $2;

1048

1049

# skip DESTROY altogether

1050

next if $method eq 'DESTROY';

1051

1052

++$nfound;

1053

1054

# don't document it if we can't actually call it.

1055

if ($package->can ($method)) {

1056

$str .= xsub_to_pod ($_, '=head2');

1057

++$nused;

1058

} else {

1059

# this print should only be temporary

1060

print STDERR "missing: $package->$method\n";

1061

}

1062

}

1063

#$str .= "=back\n\n";

1064

1065

if ($nused == 0) {

1066

# no xsubs were used.

1067

if ($nfound > 0) {

1068

# but some were found and not used.

1069

# say something to that effect.

1070

print STDERR "No methods found for $package\n";

1071

$str = "

1072

1073

Some methods defined for $package are not available in the particular

1074

library versions against which this module was compiled.

1075

1076

";

1077

} else {

1078

# no methods found, nothing to say

1079

$str = undef;

1080

}

1081

}

1082

1083

$str;

1084

}

1085

1086

=item $string = podify_see_alsos (@entries)

1087

1088

Creates a list of links to be placed in the SEE ALSO section of the page.

1089

Returns undef if nothing is in the input list.

1090

1091

=cut

1092

1093

sub podify_see_alsos

1094

{

1095

my @entries = @_;

1096

1097

return undef unless scalar @entries;

1098

1099

# create the see also list

1100

join (', ',

1101

map {

1102

if (/^\s*L</) {

1103

$_;

1104

} else {

1105

"L<$_>";

1106

}

1107

}

1108

@entries)

1109

. "\n";

1110

}

1111

1112

=item $string = get_copyright

1113

1114

Returns a string that will/should be placed on each page. You can control

1115

the text of this string by calling the class method I<set_copyright>.

1116

1117

If no text has been set, we will attempt to create one for you, using what

1118

has been passed to I<set_year>, I<set_authors>, and I<set_main_mod>. The

1119

year defaults to the current year, the authors default to

1120

'The Gtk2-Perl Team', and the main mod is empty by default. You want the

1121

main mod to be set to the main module of your extension for the SEE ALSO

1122

section, and on the assumption that a decent license notice can be found in

1123

that module's doc, we point the reader there.

1124

1125

So, in general, you will want to specify at least one of these, so that you

1126

don't credit your work to us under the LGPL.

1127

1128

To set them do something similar to the following in the first part of your

1129

postamble section in Makefile.PL. All occurences of <br> in the copyright

1130

are replaced with newlines, to make it easier to put in a multi-line string.

1131

1132

1133

1134

Glib::MakeHelper::postamble_docs_full() does this sort of thing for you.

1135

1136

=cut

1137

1138

sub get_copyright

1139

{

1140

my $str = $COPYRIGHT;

1141

if (! $str) {

1142

# construct a default.

1143

$str = "\nCopyright (C) $YEAR $AUTHORS\n\n";

1144

$str .= "This software is licensed under the LGPL;"

1145

. " see $MAIN_MOD for a full notice.\n"

1146

if $MAIN_MOD;

1147

}

1148

1149

# a way to make returns

1150

$str =~ s/<br>/\n/g;

1151

return $str."\n";

1152

}

1153

1154

sub set_copyright {

1155

$COPYRIGHT = shift;

1156

}

1157

1158

sub set_year {

1159

$YEAR = shift;

1160

}

1161

1162

sub set_authors {

1163

$AUTHORS = shift;

1164

}

1165

1166

sub set_main_mod {

1167

$MAIN_MOD = shift;

1168

eval "use $MAIN_MOD";

1169

die($@) if($@);

1170

}

1171

1172

sub preprocess_pod

1173

{

1174

my $pod = shift;

1175

1176

foreach (@{$pod->{lines}})

1177

{

1178

# =for include filename

1179

# =for include !cmd

1180

if (/^=for\s+include\s+(!)?(.*)$/)

1181

{

1182

if ($1)

1183

{

1184

chomp($_ = `$2`);

1185

}

1186

else

1187

{

1188

if (open INC, "<$2")

1189

{

1190

local $/ = undef;

1191

$_ = <INC>;

1192

}

1193

else

1194

{

1195

carp "\n\nunable to open $2 for inclusion, at ".

1196

$pod->{filename}.':'.$pod->{line};

1197

}

1198

}

1199

}

1200

}

1201

}

1202

1203

=back

1204

1205

=head2 Helpers

1206

1207

=over

1208

1209

=item $perl_type = convert_type ($ctypestring)

1210

1211

Convert a C type name to a Perl type name.

1212

1213

Uses %Glib::GenPod::basic_types to look for some known basic types,

1214

and uses Glib::Type->package_from_cname to look up the registered

1215

package corresponding to a C type name. If no suitable mapping can

1216

be found, this just returns the input string.

1217

1218

=cut

1219

1220

sub convert_type {

1221

my $typestr = shift;

1222

1223

$typestr =~ /^\s* # leading space

1224

(?:const\s+)? # maybe a const

1225

([:\w]+) # the name

1226

(\s*\*)? # maybe a star

1227

\s*$/x; # trailing space

1228

my $ctype = $1 || '!!';

1229

if ($ctype eq '!!') {

1230

warn "Glib::GenPod: Unable to parse type `$typestr´";

1231

}

1232

1233

# variant type

1234

1235

my $variant = $1 || "";

1236

1237

my $perl_type;

1238

1239

if (exists $basic_types{$ctype}) {

1240

$perl_type = $basic_types{$ctype};

1241

1242

} elsif ($ctype =~ m/::/) {

1243

# :: is not valid in GLib type names, so there's no point

1244

# in asking the GLib type system if it knows this name,

1245

# because it's probably already a perl type name.

1246

$perl_type = $ctype;

1247

1248

} else {

1249

eval

1250

{

1251

$perl_type = Glib::Type->package_from_cname ($ctype);

1252

1;

1253

} or do {

1254

# this warning will have something to do with the

1255

# package not being registered, a fact which will

1256

# of interest to a person documenting or developing

1257

# the documented module, but not to us developing

1258

# the documentation generator. thus, this warning

1259

# doesn't need a line number attribution.

1260

# let's strip that...

1261

$@ =~ s/\s*at (.*) line \d+\.$/./;

1262

warn "$@";

1263

# ... and fall back gracefully.

1264

$perl_type = $ctype;

1265

}

1266

}

1267

1268

if ($variant && $variant =~ m/ornull/) {

1269

$perl_type .= " or undef";

1270

}

1271

1272

$perl_type

1273

}

1274

1275

1276

=item $string = xsub_to_pod ($xsub, $sigprefix='')

1277

1278

Convert an xsub hash into a string of pod describing it. Includes the

1279

call signature, argument listing, and description, honoring special

1280

switches in the description pod (arg and signature overrides).

1281

1282

=cut

1283

1284

sub xsub_to_pod {

1285

my $xsub = shift;

1286

my $sigprefix = shift || '';

1287

my $alias = $xsub->{symname};

1288

my $str;

1289

1290

# ensure that if there's pod for this xsub, we have it now.

1291

# this should probably happen somewhere outside of this function,

1292

# but, eh...

1293

my @podlines = ();

1294

if (defined $xsub->{pod}) {

1295

@podlines = @{ $xsub->{pod}{lines} };

1296

}

1297

1298

# look for annotations in the pod lines.

1299

# stuff in the pods overrides whatever we'd generate.

1300

my @signatures = ();

1301

if (@podlines) {

1302

# since we're modifying the list while traversing

1303

# it, go back to front.

1304

for (my $i = $#podlines ; $i >= 0 ; $i--) {

1305

if ($podlines[$i] =~ s/^=(for\s+)?signature\s+//) {

1306

unshift @signatures, $podlines[$i];

1307

splice @podlines, $i, 1;

1308

} elsif ($podlines[$i] =~ /^=(?:for\s+)?arg\s+

1309

(\$?[\w.]+) # arg name

1310

(?:\s*$([^)]*)$)? # type

1311

\s*

1312

(.*)$/x) { # desc

1313

# this is a little convoluted, because we

1314

# need to ensure that the args array and

1315

# hash exist before using them. we may be

1316

# getting an =arg command on something that

1317

# doesn't list this name in the xsub

1318

# declaration.

1319

$xsub->{args} = [] if not exists $xsub->{args};

1320

my ($a, undef) =

1321

grep { $_->{name} eq $1 }

1322

@{ $xsub->{args} };

1323

$a = {}, push @{$xsub->{args}}, $a

1324

if not defined $a;

1325

$a->{name} = $1 if not defined $a->{name};

1326

$a->{desc} = $3;

1327

if ($2) {

1328

if ($2 =~ m/^_*hide_*$/i) {

1329

$a->{hide}++;

1330

} else {

1331

$a->{type} = $2;

1332

}

1333

}

1334

# "just eat it! eat it! get yourself and

1335

# egg and beat it!" -- weird al

1336

splice @podlines, $i, 1;

1337

}

1338

}

1339

}

1340

1341

#

1342

# the call signature(s).

1343

#

1344

push @signatures, compile_signature ($xsub)

1345

unless @signatures;

1346

1347

foreach (@signatures) {

1348

s/>(\w+)/>B<$1>/;

1349

$str .= "$sigprefix $_\n\n";

1350

}

1351

1352

#

1353

# list all the arg types.

1354

#

1355

my @args;

1356

@args = @{ $xsub->{args} } if ($xsub->{args});

1357

shift @args unless $xsub->{function};

1358

1359

$str .= "=over\n\n" if @args;

1360

foreach my $a (@args) {

1361

my $type;

1362

next if $a->{hide};

1363

if ($a->{name} eq '...') {

1364

$type = 'list';

1365

} else {

1366

if (not defined $a->{type}) {

1367

warn "$alias: no type defined for arg"

1368

. " \$$a->{name}\n";

1369

$type = "(unknown)";

1370

} else {

1371

$type = convert_arg_type ($a->{type});

1372

}

1373

}

1374

$str .= "=item * "

1375

. fixup_arg_name ($a->{name})

1376

. " ($type) "

1377

. ($a->{desc} ? $a->{desc} : "")

1378

. "\n\n";

1379

}

1380

$str .= "=back\n\n" if @args;

1381

1382

if (@podlines) {

1383

shift @podlines;

1384

pop @podlines;

1385

$str .= join("\n", @podlines)."\n\n";

1386

}

1387

1388

$str .= "May croak with a L<Glib::Error> in \$@ on failure.\n\n"

1389

if ($xsub->{gerror});

1390

1391

$str .= "This method is deprecated and should not be used in newly written code.\n\n"

1392

if ($xsub->{deprecated});

1393

1394

1395

# When there are multiple version guards of the same type, we only want

1396

# the innermost.

1397

my %version_conditions;

1398

my %prefix_to_name = (

1399

GTK => 'gtk+',

1400

);

1401

foreach (@{ $xsub->{preprocessor_conditionals} }) {

1402

if (m/^\s*(\w+)_CHECK_VERSION\s*\((\d+),\s*(\d+)/) {

1403

my $lib_name = $prefix_to_name{$1} || lc $1;

1404

$version_conditions{$lib_name} = "$2.$3";

1405

}

1406

}

1407

foreach my $lib_name (keys %version_conditions) {

1408

$str .= "Since: $lib_name $version_conditions{$lib_name}\n\n";

1409

}

1410

1411

$str

1412

}

1413

1414

=item $string = compile_signature ($xsub)

1415

1416

Given an xsub hash, return a string with the call signature for that

1417

xsub.

1418

1419

=cut

1420

1421

sub compile_signature {

1422

my $xsub = shift;

1423

1424

my @args;

1425

@args = @{ $xsub->{args} } if ($xsub->{args});

1426

1427

my $call;

1428

1429

if ($xsub->{function}) {

1430

$call = $xsub->{symname};

1431

} else {

1432

# find the method's short name

1433

my $method = $xsub->{symname};

1434

$method =~ s/^(.*):://;

1435

1436

my $package = $1 || $xsub->{package};

1437

1438

# methods always eat the first arg as the instance.

1439

my $instance = shift @args;

1440

1441

my $obj = defined ($instance->{type})

1442

? '$'.$instance->{name}

1443

: $package;

1444

1445

$call = "$obj\-E<gt>$method";

1446

}

1447

1448

# compile the arg list string

1449

my $argstr = join ", ", map {

1450

fixup_arg_name ($_->{name})

1451

. (defined $_->{default}

1452

? '='.fixup_default ($_->{default})

1453

: '')

1454

} @args;

1455

1456

# compile the return list string

1457

my @outlist = map { $_->{name} } @{ $xsub->{outlist} };

1458

if (defined $xsub->{return_type}) {

1459

my @retnames = map { convert_return_type_to_name ($_) }

1460

@{ $xsub->{return_type} };

1461

unshift @outlist, @retnames;

1462

}

1463

my $retstr = @outlist

1464

? (@outlist > 1

1465

? "(".join (", ", @outlist).")"

1466

: $outlist[0]

1467

)." = "

1468

: (defined $xsub->{codetype} and

1469

$xsub->{codetype} eq 'PPCODE'

1470

? 'list = '

1471

: ''

1472

);

1473

1474

"$retstr$call ".($argstr ? "($argstr)" : "");

1475

}

1476

1477

=item $string = fixup_arg_name ($name)

1478

1479

Prepend a $ to anything that's not the literal ellipsis string '...'.

1480

1481

=cut

1482

1483

sub fixup_arg_name {

1484

my $name = shift;

1485

my $sigil = $name eq '...' ? '' : '$';

1486

return $sigil.$name;

1487

}

1488

1489

=item fixup_default

1490

1491

Mangle default parameter values from C to Perl values. Mostly, this

1492

does NULL => undef.

1493

1494

=cut

1495

1496

sub fixup_default {

1497

my $value = shift;

1498

return (defined ($value)

1499

? ($value eq 'NULL' ? 'undef' : $value)

1500

: '');

1501

}

1502

1503

=item convert_arg_type

1504

1505

C type to Perl type conversion for argument types.

1506

1507

=cut

1508

1509

sub convert_arg_type { convert_type (@_) }

1510

1511

1512

=item convert_return_type_to_name

1513

1514

C type to Perl type conversion suitable for return types.

1515

1516

=cut

1517

1518

sub convert_return_type_to_name {

1519

my $type = convert_type (@_);

1520

if ($type =~ s/^.*:://) {

1521

$type = lc $type;

1522

}

1523

return $type;

1524

}

1525

1526

sub mkdir_p {

1527

my $path = shift;

1528

my @dirs = File::Spec->splitdir ($path);

1529

my $p = shift @dirs;

1530

do {

1531

mkdir $p or die "can't create dir $p: $!\n" unless -d $p;

1532

$p = File::Spec->catdir ($p, shift @dirs);

1533

} while (@dirs);

1534

}

1535

1536

sub convert_to_cname {

1537

my $perlname = shift;

1538

my $cname = $perlname;

1539

if($perlname =~ /^Gtk2::Gdk::/) {

1540

$cname =~ s/^Gtk2::Gdk::/Gdk/;

1541

} elsif($perlname =~ m/^Gtk2::/) {

1542

$cname =~ s/^Gtk2::/Gtk/;

1543

} elsif($perlname =~ m/^Gnome2::Bonobo::/) {

1544

$cname =~ s/^Gnome2::Bonobo::/Bonobo/;

1545

} elsif($perlname =~ m/^Gnome2::/) {

1546

$cname =~ s/^Gnome2::/Gnome/;

1547

}

1548

$cname =~ s/:://g;

1549

my $tmp;

1550

eval { $tmp = Glib::Type->package_from_cname($cname); };

1551

if($@ || $tmp ne $perlname) {

1552

return;

1553

}

1554

return $cname;

1555

}

1556

1557

1;

1558

__END__

1559

1560

=back

1561

1562

=head1 SEE ALSO

1563

1564

L<Glib::ParseXSDoc>

1565

1566

=head1 AUTHORS

1567

1568

muppet bashed out the xsub signature generation in a few hours on a wednesday

1569

night when band practice was cancelled at the last minute; he and ross

1570

mcfarland hacked this module together via irc and email over the next few days.

1571

1572

=head1 COPYRIGHT AND LICENSE

1573

1574

1575

1576

This library is free software; you can redistribute it and/or modify

1577

it under the terms of the Lesser General Public License (LGPL). For

1578

more information, see http://www.fsf.org/licenses/lgpl.txt

1579

1580

=cut