![[personal profile]](https://www.dreamwidth.org/img/silk/identity/user.png){kind=small}
![[site community profile]](https://www.dreamwidth.org/img/comm_staff.png){kind=small}
[dw-free] strip unused functions from .pms in cgi-bin
[commit: http://hg.dwscoalition.org/dw-free/rev/8f74130e5b2d]
http://bugs.dwscoalition.org/show_bug.cgi?id=1379
Remove unused functions (round 4).
Patch by![[staff profile]](https://www.dreamwidth.org/img/silk/identity/user_staff.png)
denise.
Files modified:
http://bugs.dwscoalition.org/show_bug.cgi?id=1379
Remove unused functions (round 4).
Patch by
denise.Files modified:
- cgi-bin/propparse.pl
- doc/raw/build/protocol/flat2db.pl
--------------------------------------------------------------------------------
diff -r 28873ff272f6 -r 8f74130e5b2d cgi-bin/propparse.pl
--- a/cgi-bin/propparse.pl Tue Aug 04 21:31:52 2009 -0500
+++ b/cgi-bin/propparse.pl Tue Aug 04 21:37:44 2009 -0500
@@ -6,121 +6,6 @@ package LJ;
$verbose = 0;
@obs = ();
-sub load_objects_from_file
-{
- my ($file, $oblist) = @_;
-
- # hard-code these common (er, only) cases
- if ($file eq "views.dat" || $file eq "vars.dat") {
- $file = "$LJ::HOME/doc/raw/s1/$file";
- }
-
- open (FIL, $file);
- load_objects(\*FIL, $oblist);
- close FIL;
-}
-
-sub load_objects
-{
- my ($fh, $oblist) = @_;
- my $l;
-
- while ($l = <$fh>)
- {
- chomp $l;
- next unless ($l =~ /\S/);
- next if ($l =~ /^\#/);
- if ($l =~ /^\{\s*(\S+)\s*$/)
- {
- &load_object($fh, $1, $oblist);
- }
- else
- {
- print STDERR "Unexpected line: $l\n";
- }
- }
-}
-
-sub load_object
-{
- my ($fh, $obname, $listref) = @_;
- my $var = "";
- my $vartype = "";
- my $ob = { name => $obname, props => {} };
- my $l;
-
- print "Loading object $obname ... \n" if $verbose;
- SUCKLINES:
- while ($l = <$fh>)
- {
- chomp $l;
- if ($l =~ /^\.(\S+)\s*$/)
- {
- $var = $1;
- print "current var = $var\n" if $verbose;
- next SUCKLINES;
- }
- if ($l =~ /^\}\s*$/)
- {
- print "End object $obname.\n" if $verbose;
- last SUCKLINES;
- }
- next unless $var;
- next unless ($l =~ /\S/);
- next if ($l =~ /^\#/);
-
- if ($l =~ /^\{\s*(\S+)\s*$/)
- {
- print "Encounted object ($1) as property.\n" if $verbose;
- if (defined $ob->{'props'}->{$var})
- {
- if (ref $ob->{'props'}->{$var} ne "ARRAY")
- {
- print STDERR "Object encountered where text expected.\n";
- my $blah = [];
- &load_object($fh, "blah", $blah); # ignore object
- }
- else
- {
- &load_object($fh, $1, $ob->{'props'}->{$var});
- }
- }
- else
- {
- $ob->{'props'}->{$var} = [];
- &load_object($fh, $1, $ob->{'props'}->{$var});
- }
- }
- else
- {
- print "Normal line.\n" if $verbose;
- if (defined $ob->{'props'}->{$var})
- {
- print "defined.\n" if $verbose;
- if (ref $ob->{'props'}->{$var} eq "ARRAY")
- {
- print STDERR "Scalar found where object expected!\n";
- }
- else
- {
- print "appending var \"$var\".\n" if $verbose;
- $ob->{'props'}->{$var} .= "\n$l";
- }
- }
- else
- {
- print "setting $var to $l\n" if $verbose;
- $ob->{'props'}->{$var} = $l;
- }
- }
-
- } # end while
- print "done loading object $obname\n" if $verbose;
-
- push @{$listref}, $ob;
-
-} # end sub
-
sub xlinkify
{
my ($a) = $_[0];
@@ -128,40 +13,5 @@ sub xlinkify
$$a =~ s/\[view\[(\S+?)\]\]/<a href=\"\/developer\/views\#$1\">$1<\/a>/g;
}
-sub dump_struct
-{
- my ($ref, $depth) = @_;
- my $type = ref $ref;
- my $indent = " "x$depth;
- if ($type eq "ARRAY")
- {
- print "ARRAY\n";
- my $count = 0;
- foreach (@{$ref})
- {
- print $indent, "[$count] = ";
- &dump_struct($_, $depth+1);
- $count++;
- }
- }
- elsif ($type eq "HASH")
- {
- print "HASH\n";
- my $k;
- foreach $k (sort keys %{$ref})
- {
- print $indent, "{$k} = ";
- &dump_struct($ref->{$k}, $depth+1);
- }
- }
- elsif ($type eq "")
- {
- print $ref, "\n";
- }
- else
- {
- print $indent, "UNKNOWN_TYPE";
- }
-}
1;
diff -r 28873ff272f6 -r 8f74130e5b2d doc/raw/build/protocol/flat2db.pl
--- a/doc/raw/build/protocol/flat2db.pl Tue Aug 04 21:31:52 2009 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,67 +0,0 @@
-#!/usr/bin/perl
-#
-
- use strict;
-
-$LJ::HOME = $ENV{'LJHOME'};
-
- unless (-d $LJ::HOME) { die "\$LJHOME not set.\n"; }
-
- require "$LJ::HOME/doc/raw/build/docbooklib.pl";
- require "$LJ::HOME/cgi-bin/propparse.pl";
-
- my @vars;
- LJ::load_objects_from_file("$LJ::HOME/htdocs/protocol.dat", \@vars);
-
- foreach my $mode (sort { $a->{'name'} cmp $b->{'name'} } @vars)
- {
- my $name = $mode->{'name'};
- my $des = $mode->{'props'}->{'des'};
- cleanse(\$des);
-
- unshift (@{$mode->{'props'}->{'request'}},
- { 'name' => "mode", 'props' => { 'des' => "The protocol request mode: <tt>$name</tt>", } },
- { 'name' => "user", 'props' => { 'des' => "Username. Leading and trailing whitespace is ignored, as is case.", } },
- { 'name' => "auth_method", 'props' => { 'des' => "The authentication method used for this request. Default is 'clear', for plain-text authentication. 'cookie' or any of the challenge-response methods are also acceptable.", } },
- { 'name' => "password", 'props' => { 'des' => "<strong>Deprecated</strong>. Password in plain-text. For the default authentication method, either this needs to be sent, or <tt>hpassword</tt>.", } },
- { 'name' => "hpassword", 'props' => { 'des' => "<strong>Deprecated</strong>. Alternative to plain-text <tt>password</tt>. Password as an MD5 hex digest. Not perfectly secure, but defeats the most simple of network sniffers.", } },
- { 'name' => "auth_challenge", 'props' => { 'des' => "If using challenge-response authentication, this should be the challenge that was generated for your client.", } },
- { 'name' => "auth_response", 'props' => { 'des' => "If using challenge-response authentication, this should be the response hash you generate based on the challenge's formula.", } },
- { 'name' => "ver", 'props' => { 'des' => "Protocol version supported by the client; assumed to be 0 if not specified. See [special[cspversion]] for details on the protocol version.", 'optional' => 1, } },
- ) unless $name eq "getchallenge";
- unshift (@{$mode->{'props'}->{'response'}},
- { 'name' => "success", 'props' => { 'des' => "<b><tt>OK</tt></b> on success or <b><tt>FAIL</tt></b> when there's an error. When there's an error, see <tt>errmsg</tt> for the error text. The absence of this variable should also be considered an error.", } },
- { 'name' => "errmsg", 'props' => { 'des' => "The error message if <tt>success</tt> was <tt>FAIL</tt>, not present if <tt>OK</tt>. If the success variable is not present, this variable most likely will not be either (in the case of a server error), and clients should just report \"Server Error, try again later.\".", } },
- );
- print "<refentry id=\"ljp.csp.flat.$name\">\n";
- print " <refnamediv>\n <refname>$name</refname>\n";
- print " <refpurpose>$des</refpurpose>\n </refnamediv>\n";
-
- print " <refsect1>\n <title>Mode Description</title>\n";
- print " <para>$des</para>\n </refsect1>\n";
- foreach my $rr (qw(request response))
- {
- print "<refsect1>\n";
- my $title = $rr eq "request" ? "Arguments" : "Return Values";
- print " <title>$title</title>\n";
- print " <variablelist>\n";
- foreach (@{$mode->{'props'}->{$rr}})
- {
- print " <varlistentry>\n";
- cleanse(\$_->{'name'});
- print " <term><literal>$_->{'name'}</literal></term>\n";
- print " <listitem><para>\n";
- if ($_->{'props'}->{'optional'}) {
- print "<emphasis>(Optional)</emphasis>\n";
- }
- cleanse(\$_->{'props'}->{'des'});
- print "$_->{'props'}->{'des'}\n";
- print " </para></listitem>\n";
- print " </varlistentry>\n";
- }
- print " </variablelist>\n";
- print "</refsect1>\n";
- }
- print "</refentry>\n";
- }
-
--------------------------------------------------------------------------------