~ubuntu-branches/ubuntu/edgy/libapache2-mod-perl2/edgy

« back to all changes in this revision

Viewing changes to lib/ModPerl/Code.pm

• browse files at revision 7
• compare with another revision
• download diff
• download tarball
• view history from revision 7

Show diffs side-by-side

added

removed

lib/ModPerl/Code.pm

125

125

    }

126

126

}

127

127

 

128

 

while (my($k,$v) = each %directive_proto) {

 

128

while (my ($k,$v) = each %directive_proto) {

129

129

    $directive_proto{$k}->{ret} = 'const char *';

130

130

    my $handlers = join '_', 'handlers', canon_lc($k);

131

131

    $directive_proto{$k}->{handlers} =

168

168

sub path { shift->{path} }

169

169

 

170

170

sub handler_desc {

171

 

    my($self, $h_add, $c_add) = @_;

 

171

    my ($self, $h_add, $c_add) = @_;

172

172

    local $" = ",\n";

173

 

    while (my($class, $h) = each %{ $self->{handler_index_desc} }) {

 

173

    while (my ($class, $h) = each %{ $self->{handler_index_desc} }) {

174

174

        my $func = canon_func('handler', 'desc', $class);

175

175

        my $array = join '_', 'MP', $func;

176

176

        my $proto = "const char *$func(int idx)";

192

192

}

193

193

 

194

194

sub generate_handler_index {

195

 

    my($self, $h_fh) = @_;

 

195

    my ($self, $h_fh) = @_;

196

196

 

197

197

    my $type = 1;

198

198

 

199

 

    while (my($class, $handlers) = each %{ $self->{handlers} }) {

 

199

    while (my ($class, $handlers) = each %{ $self->{handlers} }) {

200

200

        my $i = 0;

201

201

        my $n = @$handlers;

202

202

        my $handler_type = canon_define('HANDLER_TYPE', $class);

220

220

}

221

221

 

222

222

sub generate_handler_hooks {

223

 

    my($self, $h_fh, $c_fh) = @_;

 

223

    my ($self, $h_fh, $c_fh) = @_;

224

224

 

225

225

    my @register_hooks;

226

226

 

227

 

    while (my($class, $prototype) = each %{ $self->{hook_proto} }) {

 

227

    while (my ($class, $prototype) = each %{ $self->{hook_proto} }) {

228

228

        my $callback = canon_func('callback', $class);

229

229

        my $return = $prototype->{ret} eq 'void' ? '' : 'return';

230

230

        my $i = -1;

243

243

                  "    ap_hook_$hook($name, NULL, NULL, $order);";

244

244

            }

245

245

 

246

 

            my($protostr, $pass) = canon_proto($prototype, $name);

 

246

            my ($protostr, $pass) = canon_proto($prototype, $name);

247

247

            my $ix = $self->{handler_index}->{$class}->[$i];

248

248

 

249

249

            if ($callback =~ m/modperl_callback_per_(dir|srv)/) {

275

275

}

276

276

 

277

277

sub generate_handler_find {

278

 

    my($self, $h_fh, $c_fh) = @_;

 

278

    my ($self, $h_fh, $c_fh) = @_;

279

279

 

280

280

    my $proto = 'int modperl_handler_lookup(const char *name, int *type)';

281

 

    my(%ix, %switch);

 

281

    my (%ix, %switch);

282

282

 

283

283

    print $h_fh "$proto;\n";

284

284

 

292

292

    switch (*name) {

293

293

EOF

294

294

 

295

 

    while (my($class, $handlers) = each %{ $self->{handlers} }) {

 

295

    while (my ($class, $handlers) = each %{ $self->{handlers} }) {

296

296

        my $i = 0;

297

297

 

298

298

        for my $name (@$handlers) {

334

334

}

335

335

 

336

336

sub generate_handler_directives {

337

 

    my($self, $h_fh, $c_fh) = @_;

 

337

    my ($self, $h_fh, $c_fh) = @_;

338

338

 

339

339

    my @cmd_entries;

340

340

 

341

 

    while (my($class, $handlers) = each %{ $self->{handlers} }) {

 

341

    while (my ($class, $handlers) = each %{ $self->{handlers} }) {

342

342

        my $prototype = $self->{directive_proto}->{$class};

343

343

        my $i = 0;

344

344

 

391

391

}

392

392

 

393

393

sub generate_flags {

394

 

    my($self, $h_fh, $c_fh) = @_;

 

394

    my ($self, $h_fh, $c_fh) = @_;

395

395

 

396

396

    my $n = 1;

397

397

 

399

399

 

400

400

    print $h_fh "\n#define MP_SYS_$dlsrc 1\n";

401

401

 

402

 

    while (my($class, $opts) = each %{ $self->{flags} }) {

 

402

    while (my ($class, $opts) = each %{ $self->{flags} }) {

403

403

        my @lookup = ();

404

404

        my %lookup = ();

405

405

        my $lookup_proto = "";

499

499

);

500

500

 

501

501

sub generate_trace {

502

 

    my($self, $h_fh) = @_;

 

502

    my ($self, $h_fh) = @_;

503

503

 

504

504

    my $v     = $self->{build}->{VERSION};

505

505

    my $api_v = $self->{build}->{API_VERSION};

560

560

}

561

561

 

562

562

sub generate_largefiles {

563

 

    my($self, $h_fh) = @_;

 

563

    my ($self, $h_fh) = @_;

564

564

 

565

565

    my $flags = $self->perl_config('ccflags_uselargefiles');

566

566

 

568

568

 

569

569

    for my $flag (split /\s+/, $flags) {

570

570

        next if $flag =~ /^-/; # skip -foo flags

571

 

        my($name, $val) = split '=', $flag;

 

571

        my ($name, $val) = split '=', $flag;

572

572

        $val ||= '';

573

573

        $name =~ s/^-D//;

574

574

        print $h_fh "#define $name $val\n";

619

619

}

620

620

 

621

621

sub canon_proto {

622

 

    my($prototype, $name) = @_;

623

 

    my($in,$pass) = canon_args($prototype);

 

622

    my ($prototype, $name) = @_;

 

623

    my ($in,$pass) = canon_args($prototype);

624

624

 

625

625

    local $" = ', ';

626

626

 

710

710

}

711

711

 

712

712

sub init_file {

713

 

    my($self, $name) = @_;

 

713

    my ($self, $name) = @_;

714

714

 

715

715

    return unless $name;

716

716

    return if $self->{init_files}->{$name}++;

717

717

 

718

 

    my(@preamble);

 

718

    my (@preamble);

719

719

    if ($name =~ /\.h$/) {

720

720

        (my $d = uc $name) =~ s/\./_/;

721

721

        push @preamble, "#ifndef $d\n#define $d\n";

735

735

}

736

736

 

737

737

sub fh {

738

 

    my($self, $name) = @_;

 

738

    my ($self, $name) = @_;

739

739

    return unless $name;

740

740

    $self->{fh}->{$name};

741

741

}

749

749

}

750

750

 

751

751

sub generate {

752

 

    my($self, $build) = @_;

 

752

    my ($self, $build) = @_;

753

753

 

754

754

    $self->{build} = $build;

755

755

 

760

760

    }

761

761

 

762

762

    for my $method (reverse sort keys %sources) {

763

 

        my($h_fh, $c_fh) = map {

 

763

        my ($h_fh, $c_fh) = map {

764

764

            $self->fh($sources{$method}->{$_});

765

765

        } qw(h c);

766

 

        my($h_add, $c_add) = $self->$method($h_fh, $c_fh);

 

766

        my ($h_add, $c_add) = $self->$method($h_fh, $c_fh);

767

767

        if ($h_add) {

768

768

            print $h_fh $h_add;

769

769

        }

788

788

my $constant_prefixes = join '|', qw{APR? MODPERL_RC};

789

789

 

790

790

sub generate_constants {

791

 

    my($self, $h_fh, $c_fh) = @_;

 

791

    my ($self, $h_fh, $c_fh) = @_;

792

792

 

793

793

    require Apache2::ConstantsTable;

794

794

 

827

827

}

828

828

 

829

829

sub constants_lookup_code {

830

 

    my($h_fh, $c_fh, $constants, $class) = @_;

 

830

    my ($h_fh, $c_fh, $constants, $class) = @_;

831

831

 

832

 

    my(%switch, %alias);

 

832

    my (%switch, %alias);

833

833

 

834

834

    %alias = %shortcuts;

835

835

 

836

836

    my $postfix = canon_lc(lc $class);

837

837

    my $package = $class . '::';

838

838

    my $package_len = length $package;

839

 

    my($first_let) = $class =~ /^(\w)/;

 

839

    my ($first_let) = $class =~ /^(\w)/;

840

840

 

841

841

    my $func = canon_func(qw(constants lookup), $postfix);

842

842

    my $proto = "SV \*$func(pTHX_ const char *name)";

906

906

}

907

907

 

908

908

sub generate_constants_lookup {

909

 

    my($h_fh, $c_fh) = @_;

 

909

    my ($h_fh, $c_fh) = @_;

910

910

 

911

 

    while (my($class, $groups) = each %$Apache2::ConstantsTable) {

 

911

    while (my ($class, $groups) = each %$Apache2::ConstantsTable) {

912

912

        my $constants = [map { @$_ } values %$groups];

913

913

 

914

914

        constants_lookup_code($h_fh, $c_fh, $constants, $class);

916

916

}

917

917

 

918

918

sub generate_constants_group_lookup {

919

 

    my($h_fh, $c_fh) = @_;

 

919

    my ($h_fh, $c_fh) = @_;

920

920

 

921

 

    while (my($class, $groups) = each %$Apache2::ConstantsTable) {

 

921

    while (my ($class, $groups) = each %$Apache2::ConstantsTable) {

922

922

        constants_group_lookup_code($h_fh, $c_fh, $class, $groups);

923

923

    }

924

924

}

925

925

 

926

926

sub constants_group_lookup_code {

927

 

    my($h_fh, $c_fh, $class, $groups) = @_;

 

927

    my ($h_fh, $c_fh, $class, $groups) = @_;

928

928

    my @tags;

929

929

    my @code;

930

930

 

931

931

    $class = canon_lc(lc $class);

932

 

    while (my($group, $constants) = each %$groups) {

 

932

    while (my ($group, $constants) = each %$groups) {

933

933

        push @tags, $group;

934

934

        my $name = join '_', 'MP_constants', $class, $group;

935

935

        print $c_fh "\nstatic const char *$name [] = { \n",

974

974

my %seen_const = ();

975

975

# generates APR::Const and Apache2::Const manpages in ./tmp/

976

976

sub generate_constants_pod {

977

 

    my($self) = @_;

 

977

    my ($self) = @_;

978

978

 

979

979

    my %data = ();

980

980

    generate_constants_group_lookup_doc(\%data);

1026

1026

}

1027

1027

 

1028

1028

sub generate_constants_lookup_doc {

1029

 

    my($data) = @_;

 

1029

    my ($data) = @_;

1030

1030

 

1031

 

    while (my($class, $groups) = each %$Apache2::ConstantsTable) {

 

1031

    while (my ($class, $groups) = each %$Apache2::ConstantsTable) {

1032

1032

        my $constants = [map { @$_ } values %$groups];

1033

1033

 

1034

1034

        constants_lookup_code_doc($constants, $class, $data);

1036

1036

}

1037

1037

 

1038

1038

sub generate_constants_group_lookup_doc {

1039

 

    my($data) = @_;

 

1039

    my ($data) = @_;

1040

1040

 

1041

 

    while (my($class, $groups) = each %$Apache2::ConstantsTable) {

 

1041

    while (my ($class, $groups) = each %$Apache2::ConstantsTable) {

1042

1042

        constants_group_lookup_code_doc($class, $groups, $data);

1043

1043

    }

1044

1044

}

1045

1045

 

1046

1046

sub constants_group_lookup_code_doc {

1047

 

    my($class, $groups, $data) = @_;

 

1047

    my ($class, $groups, $data) = @_;

1048

1048

    my @tags;

1049

1049

    my @code;

1050

1050

 

1051

 

    while (my($group, $constants) = each %$groups) {

 

1051

    while (my ($group, $constants) = each %$groups) {

1052

1052

        $data->{$class}{$group} = [

1053

1053

            map {

1054

1054

                my @ifdef = constants_ifdef($_);

1061

1061

}

1062

1062

 

1063

1063

sub constants_lookup_code_doc {

1064

 

    my($constants, $class, $data) = @_;

 

1064

    my ($constants, $class, $data) = @_;

1065

1065

 

1066

 

    my(%switch, %alias);

 

1066

    my (%switch, %alias);

1067

1067

 

1068

1068

    %alias = %shortcuts;

1069

1069

 

1095

1095

}

1096

1096

 

1097

1097

sub generate_exports {

1098

 

    my($self, $c_fh) = @_;

 

1098

    my ($self, $c_fh) = @_;

1099

1099

    require ModPerl::WrapXS;

1100

1100

    ModPerl::WrapXS->generate_exports($c_fh);

1101

1101

}

• Older »

Loggerhead is a web-based interface for Breezy
Version: 2.0.1