Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Craft

( #481=superdoc: print w/ replies, xml ) Need Help??

This section is obsolete. To post new code, please use Cool Uses For Perl.

User craft
Anti-Spam Mail Address Encoding (with encrypted IP-Address)
6 direct replies — Read more / Contribute
by projekt21
on Jul 10, 2003 at 05:30
    #!/usr/bin/perl
    # spamtrap_encode/spamtrap_decode
    # zeitform Internet Dienste (c) 2003
    # alex@zeitform.de - Version 0.1
    #
    # encrypt timestamp and ip address for random mail-addresses
    #
    # spamtrap_encode creates a blowfish encrypted hex string
    # based on a given ip address and timestamp to construct
    # dynamic mail addresses for online publishing
    #
    # If you publish your email address on your web site, you will
    # be spammed. To minimize this, you can use methods to
    # trick address harvesters:
    # 
    #   * "user at domain dot com"
    #   * "user-nospam@domain.com"
    #   * HTML encoded mailto
    #   * JavaScript generated mailto
    #   * other methods
    #
    # The method proposed by this encoder creates mail addresses
    # that include a timestamp and the ip address of the remote
    # host (i.e. of the harvester). This enables you to reveal
    # the harvester's ip adress for received spam. 
    #
    # usage:
    #
    # my $ip   = $ENV{REMOTE_ADDR};   # e.g. "146.140.8.123"
    # my $time = time;                # unix timestamp
    # my $key  = "0123456789ABCDEF";  # key for Blowfish
    #
    # to generate the spamtrap string:
    #
    # my $string = spamtrap_encode($ip, $time, $key);  # e.g. 78c1ed6da032
    +2b3a
    #
    # to decode:
    #
    # ($ip, $time) = spamtrap_decode($string, $key);   # returns ip addres
    +s and timestamp
    #
    # Example:
    #
    # If you have an E-Mail address "joe@domain.com" and use qmail
    # extensions to have addresses like "joe-anything@domain.com"
    # you could publish your E-Mail address on websites with:
    #
    # print '<a href="mailto:joe-' . spamtrap_encode($ip, $time, $key) . '
    +@domain.com">Joe</a>';
    #
    # which prints:
    #
    #  <a href="mailto:joe-78c1ed6da0322b3a@domain.com">Joe</a>
    #
    # A perfect trap for address harvesters!
    #
    # Many thanks to Daniel A. Rehbein (http://daniel.rehbein.net/)
    # for the idea to this code.
    #
    #### some dumy input
    #
    #  $ip   = quad-dooted ip address
    #  $time = unix timestamp
    #  $key  = your secret key
    
    my $ip   = "146.140.8.123";
    my $time = time;
    my $key  = "0123456789ABCDEF";
    
    #### end dummy input
    
    my $string = spamtrap_encode($ip, $time, $key);
    
    print "time:   $time\n";
    print "ip:     $ip\n";
    print "cipher: $string\n";
    
    ($ip, $time) = spamtrap_decode($string, $key);
    
    print "time:   $time\n";
    print "ip:     $ip\n";
    
    exit;
    
    ### sub land
    
    sub spamtrap_encode
      {
        my ($ip, $time, $key) = @_;
        return unless $key;
        return unless $time > 0;
        return unless $ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/o;
        my $inkey = pack("H16", $key);
        my $plaintext = join("", map { chr } split (/\./, $ip)) . pack("L"
    +, $time);
        use Crypt::Blowfish;
        my $cipher = new Crypt::Blowfish $inkey;
        my $string = unpack("H*", $cipher->encrypt($plaintext));
        return $string;
      }
    
    sub spamtrap_decode
      {
        my ($string, $key) = @_;
        return unless $key;
        return unless $string =~ /[0-9a-f]{16}/o;
        my $inkey = pack("H16", $key);
        use Crypt::Blowfish;
        my $cipher = new Crypt::Blowfish $inkey;
        my $plaintext = $cipher->decrypt(pack("H*", $string));
        my $time = unpack("L", substr($plaintext, 4, 4));
        my $ip = join(".", map { ord } split //, substr($plaintext, 0, 4))
    +;
        return wantarray ? ($ip, $time) : "$ip $time";
      }
    
    ###-fin
    
Something simpler than HTML::Calendar::Simple
3 direct replies — Read more / Contribute
by oakbox
on Jun 23, 2003 at 10:27
    #!/usr/bin/perl
    
    # I wanted something VERY SIMPLE for generating an
    # HTML calendar.  I didn't want to wade through the interface
    # for  HTML::Calendar::Simple, or worry about Entities.
    
    # This script looks at the time, backtracks to the first of
    # the month, and then prints out an HTML calendar for this 
    # month.  You can manipulate the month being printed by fiddling
    # with the $now variable and you can put information into the 
    # calendar easily where commented.
    
    # Oakbox Productions - Richard Still (oakbox)
    
    use strict;
    
    my $message;  # variable to hold output
    
    my $now = time;
    
    my @wday = localtime($now);
    
    my %dayrev = (  "0" => "Sun",
                "1" => "Mon",
            "2" => "Tue",
            "3" => "Wed",
            "4" => "Thu",
            "5" => "Fri",
            "6" => "Sat");
    
    my %monrev = (  "0" => "Jan",
                "1" => "Feb",
            "2" => "Mar",
            "3" => "Apr",
            "4" => "May",
            "5" => "Jun",
            "6" => "Jul",
            "7" => "Aug",
            "8" => "Sep",
            "9" => "Oct",
            "10" => "Nov",
            "11" => "Dec");
    
    
    use Time::Local;
    
    $message.=qq(<span class="big"> $monrev{$wday[4]} </span>
            <br> <table border="1" cellspacing="0" cellpadding"3" width="1
    +00%">
                   <tr bgcolor="#679cd3" class="big">
                     <td align="center"> $dayrev{0} </td>
                     <td align="center"> $dayrev{1} </td>
                     <td align="center"> $dayrev{2} </td>
                     <td align="center"> $dayrev{3} </td>
                     <td align="center"> $dayrev{4} </td>
                     <td align="center"> $dayrev{5} </td>
                     <td align="center"> $dayrev{6} </td>
                   </tr>);
    
    # I have to move the start date a little bit to get Sunday
    # over to the first position
    
    my $fday = timelocal(0,0,0,1,$wday[4],$wday[5]);
    my @ltime = localtime($fday);
    if($ltime[6] ne "0"){
        $message.=qq(<tr>);
    
      foreach my $cl (0...($ltime[6] - 1)){
        $message.=qq(<td> &nbsp; </td> );
      }
    }else{
    
        $message.=qq(<tr>);
    
    }
    
    my $endm;
    
    foreach my $daycount (1...31){
       my $thisday;
       eval {   $thisday = timelocal(0,0,0,$daycount,$wday[4],$wday[5]);  
    +}; 
       if( $@ ){ next; }
       my @ltime = localtime($thisday);
       $endm = $ltime[6]; # signal to next section about what day we ended
    + on
    
       my $color = qq();
    
    ## This is where you want to put stuff INTO your calendar
    ## but that's optional :)
    
       $message.=qq(<td $color> $daycount<p> &nbsp; </td>\n);
    
       if($ltime[6] eq "6"){ $message.=qq(</tr><tr>\n); }
    }
    
    # close up the table by filling in any missing days
    
    if($endm ne "6"){
      foreach my $cl (($endm+1)...6){
        $message.=qq(<td> &nbsp; </td> );
      }
    }
        $message.=qq(</tr></table>);
    
    
    # little html out template
    
     my $html_frame=qq(<html>
                <head>
    <style type="text/css">
    <!--
    td, body, p {  font-family: Arial, Helvetica, sans-serif; font-size: 1
    +2px}
    .big {  font-family: Arial, Helvetica, sans-serif; font-size: 14px}
    -->
    </style>
    <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1
    +">
    </head>
    
    <body bgcolor="#FFFFFF" text="#000000">
    <p>$message</p>
    </body>
    </html>);
        
    print "Content-type: text/html\n\n";
    print "$html_frame";
    
    exit;
    
grouping consecutive integers
4 direct replies — Read more / Contribute
by oboyle
on Apr 15, 2003 at 11:19
    Here's a function I wrote to group consecutive sets of integers in to 
    +a tabular form.
    
    ####
    ##
    ## my $table_hrf = consecutive( \@integers )
    ##
    ## Description: function to find consecutive integers
    ##
    ## Parameters: a reference to an array of integers
    ##
    ## Returns: table of sorted, grouped integers in the form of
    ##
    ##            base_integer => sequence_length
    ##
    ## For instance, the list
    ##
    ##  qw( 20 2 3 4 5 6 7 23 19 17 25 30 11 12 22 21 68 103829 24 18 );
    ##
    ## will sort to
    ##
    ##       2 => 5,
    ##      11 => 1,
    ##      17 => 8,
    ##      30 => 0,
    ##      68 => 0,
    ##  103829 => 0
    ##
    ## which means
    ##
    ##  sequence(5): 2 to 7
    ##  sequence(1): 11 to 12
    ##  sequence(8): 17 to 25
    ##  single: 30
    ##  single: 68
    ##  single: 103829
    ##
    ####
    sub consecutive
    {
      my $integer_arf = shift;
    
      my %table = ( );
    
      my $base = 0;
      my $previous = 0;
    
      foreach my $number ( sort numerically @{ $integer_arf } )
      {
        if( ( $number - 1 ) == $previous ) # if the current number is one 
    +greater
        {                                  # than the previous, increment 
    +our base
          $table{ $base }++;
        }
        else # we've found a new sequence
        {
          $table{ $number } = 0; # we're the base number, so set our adder
    + to 0
          $base = $number;
        }
    
        $previous = $number; # end of loop -- our $number is now old
      }
    
      return \%table;
    }
    
    sub numerically { $a <=> $b }
    
Archive::Ar - pure perl way to handle Ar archives (comments encouraged)
1 direct reply — Read more / Contribute
by JayBonci
on Apr 08, 2003 at 03:17
    package Archive::Ar;
    
    ###########################################################
    #    Archive::Ar - Pure perl module to handle ar achives
    #    
    #    Copyright 2003 - Jay Bonci <jaybonci@cpan.org>
    #    Licensed under the same terms as perl itself
    #
    ###########################################################
    
    use strict;
    use Exporter;
    use File::Spec;
    use Time::Local;
    
    use vars qw($VERSION @ISA @EXPORT);
    $VERSION = '1.1';
    
    use constant ARMAG => "!<arch>\n";
    use constant SARMAG => length(ARMAG);
    use constant ARFMAG => "`\n";
    
    @ISA=qw(Exporter);
    @EXPORT=qw/read read_memory list_files add_files add_data write get_co
    +ntent DEBUG/;
    
    sub new {
        my ($class, $filenameorhandle, $debug) = @_;
    
        my $this = {};
    
        my $obj = bless $this, $class;
    
        $obj->{_verbose} = 0;
        $obj->_initValues();
    
    
        if($debug)
        {
            $obj->DEBUG();
        }
    
        if($filenameorhandle){
            unless($obj->read($filenameorhandle)){
                $obj->_dowarn("new() failed on filename or filehandle read
    +");
                return;
            }        
        }
    
        return $obj;
    }
    
    sub read
    {
        my ($this, $filenameorhandle) = @_;
    
        my $retval;
    
        $this->_initValues();
    
        if(ref $filenameorhandle eq "GLOB")
        {
            unless($retval = $this->_readFromFilehandle($filenameorhandle)
    +)
            {
                $this->_dowarn("Read from filehandle failed");
                return;
            }
        }else
        {
            unless($retval = $this->_readFromFilename($filenameorhandle))
            {
                $this->_dowarn("Read from filename failed");
                return;
            }
        }
    
    
        unless($this->_parseData())
        {
            $this->_dowarn("read() failed on data structure analysis. Prob
    +able bad file");
            return; 
        }
    
        
        return $retval;
    }
    
    sub read_memory
    {
        my ($this, $data) = @_;
    
        $this->_initValues();
    
        unless($data)
        {
            $this->_dowarn("read_memory() can't continue because no data w
    +as given");
            return;
        }
    
        $this->{_filedata} = $data;
    
        unless($this->_parseData())
        {
            $this->_dowarn("read_memory() failed on data structure analysi
    +s. Probable bad file");
            return;
        }
    
        return length($data);
    }
    
    sub list_files
    {
        my($this) = @_;
    
        return \@{$this->{_files}};
    
    }
    
    sub add_files
    {
        my($this, $filenameorarray, @otherfiles) = @_;
        
        my $filelist;
    
        if(ref $filenameorarray eq "ARRAY")
        {
            $filelist = $filenameorarray;
        }else
        {
            $filelist = [$filenameorarray];
            if(@otherfiles)
            {
                push @$filelist, @otherfiles;
            }
        }
    
        my $filecount = 0;
    
        foreach my $filename (@$filelist)
        {
            my @props = stat($filename);
            unless(@props)
            {
                $this->_dowarn("Could not stat() filename. add_files() for
    + this file failed");
                next;
            }
            my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime
    +,$ctime,$blksize,$blocks) = @props;  
            
            my $header = {
                "date" => $mtime,
                "uid"  => $uid,
                "gid"  => $gid, 
                "mode" => $mode,
                "size" => $size,
            };
    
            local $/ = undef;
            unless(open HANDLE, $filename)
            {
                $this->_dowarn("Could not open filename. add_files() for t
    +his file failed");
                next;
            }
            $header->{data} = <HANDLE>;
            close HANDLE;
    
            # fix the filename
    
            (undef, undef, $filename) = File::Spec->splitpath($filename);
            $header->{name} = $filename;
    
            $this->_addFile($header);
    
            $filecount++;
        }
    
        return $filecount;
    }
    
    sub add_data
    {
        my($this, $filename, $data, $params) = @_;
        unless ($filename)
        {
            $this->_dowarn("No filename given; add_data() can't proceed");
            return;
        }
    
        $params ||= {};
        $data ||= "";
        
        (undef, undef, $filename) = File::Spec->splitpath($filename);
        
        $params->{name} = $filename;    
        $params->{size} = length($data);
        $params->{data} = $data;
        $params->{uid} ||= 0;
        $params->{gid} ||= 0;
        $params->{date} ||= timelocal(localtime());
        $params->{mode} ||= "100644";
        
        unless($this->_addFile($params))
        {
            $this->_dowarn("add_data failed due to a failure in _addFile")
    +;
            return;
        }
    
        return $params->{size};     
    }
    
    sub write
    {
        my($this, $filename) = @_;
    
        my $outstr;
    
        $outstr= ARMAG;
        foreach(@{$this->{_files}})
        {
            my $content = $this->get_content($_);
            unless($content)
            {
                $this->_dowarn("Internal Error. $_ file in _files list but
    + no filedata");
                next;
            }
            
    
            # For whatever reason, the uids and gids get stripped
            # if they are zero. We'll blank them here to emulate that
    
            $content->{uid} ||= "";
            $content->{gid} ||= "";
    
            $outstr.= pack("A16A12A6A6A8A10", @$content{qw/name date uid g
    +id mode size/});
            $outstr.= ARFMAG;
            $outstr.= $content->{data};
        }
    
        return $outstr unless $filename;
    
        unless(open HANDLE, ">$filename")
        {
            $this->_dowarn("Can't open filename $filename");
            return;
        }
        print HANDLE $outstr;
        close HANDLE;
        return length($outstr);
    }
    
    sub get_content
    {
        my ($this, $filename) = @_;
    
        unless($filename)
        {
            $this->_dowarn("get_content can't continue without a filename"
    +);
            return;
        }
    
        unless(exists($this->{_filehash}->{$filename}))
        {
            $this->_dowarn("get_content failed because there is not a file
    + named $filename");
            return;
        }
    
        return $this->{_filehash}->{$filename};
    }
    
    sub DEBUG
    {
        my($this, $verbose) = @_;
        $verbose = 1 unless(defined($verbose) and int($verbose) == 0);
        $this->{_verbose} = $verbose;
        return;
    
    }
    
    sub _parseData
    {
        my($this) = @_;
    
        unless($this->{_filedata})
        {
            $this->_dowarn("Cannot parse this archive. It appears to be bl
    +ank");
            return;
        }
    
        my $scratchdata = $this->{_filedata};
    
        unless(substr($scratchdata, 0, SARMAG, "") eq ARMAG)
        {
            $this->_dowarn("Bad magic header token. Either this file is no
    +t an ar archive, or it is damaged. If you are sure of the file integr
    +ity, Archive::Ar may not support this type of ar archive currently. P
    +lease report this as a bug");
            return "";
        }
    
        while($scratchdata =~ /\S/)
        {
    
            if($scratchdata =~ s/^(.{58})`\n//m)        
            {
                my @fields = unpack("A16A12A6A6A8A10", $1);
    
                for(0..@fields)
                {
                    $fields[$_] ||= "";
                    $fields[$_] =~ s/\s*$//g;
                }
    
                my $headers = {};
                @$headers{qw/name date uid gid mode size/} = @fields;
    
                $headers->{data} = substr($scratchdata, 0, $headers->{size
    +}, "");
    
                $this->_addFile($headers);
            }else{
                $this->_dowarn("File format appears to be corrupt. The fil
    +e header is not of the right size, or does not exist at all");
                return;
            }
        }
    
        return scalar($this->{_files});
    }
    
    sub _readFromFilename
    {
        my ($this, $filename) = @_;
    
        my $handle;
        open $handle, $filename or return;
        return $this->_readFromFilehandle($handle);
    }
    
    
    sub _readFromFilehandle
    {
        my ($this, $filehandle) = @_;
        return unless $filehandle;
    
        #handle has to be open
        return unless(fileno $filehandle);
    
        local $/ = undef;
        $this->{_filedata} = <$filehandle>;
        close $filehandle;
    
        return length($this->{_filedata});
    }
    
    sub _addFile
    {
        my ($this, $file) = @_;
    
        return unless $file;
    
        foreach(qw/name date uid gid mode size data/)
        {
            unless(exists($file->{$_}))
            {
                $this->_dowarn("Can't _addFile because virtual file is mis
    +sing $_ parameter");
                return;
            }
        }
        
        if(exists($this->{_filehash}->{$file->{name}}))
        {
            $this->_dowarn("Can't _addFile because virtual file already ex
    +ists with that name in the archive");
            return;
        }
    
        push @{$this->{_files}}, $file->{name};
        $this->{_filehash}->{$file->{name}} = $file;
    
        return $file->{name};
    }
    
    sub _initValues
    {
        my ($this) = @_;
    
        $this->{_files} = [];
        $this->{_filehash} = {};
        $this->{_filedata} ="";
    
        return;
    }
    
    sub _dowarn
    {
        my ($this, $warning) = @_;
    
        if($this->{_verbose})
        {
            warn "DEBUG: $warning";
        }
    
        return;
    }
    
    1;
    
    
    =head1 NAME
    
    Archive::Ar - Interface for manipulating ar archives
    
    =head1 SYNOPSIS
    
    use Archive::Ar;
    
    my $ar = new Archive::Ar("./foo.ar");
    
    $ar->add_data("newfile.txt","Some contents", $properties);
    
    $ar->add_files("./bar.tar.gz", "bat.pl")
    $ar->add_files(["./again.gz"]);
    
    my $filedata = $ar->get_content("bar.tar.gz");
    
    my @files = $ar->list_files();
    $ar->read("foo.deb");
    
    $ar->write("outbound.ar");
    
    $ar->DEBUG();
    
    
    =head1 DESCRIPTION
    
    Archive::Ar is a pure-perl way to handle standard ar archives.  
    
    This is useful if you have those types of old archives on the system, 
    +but it 
    is also useful because .deb packages for the Debian GNU/Linux distribu
    +tion are 
    ar archives. This is one building block in a future chain of modules t
    +o build, 
    manipulate, extrace, and test debian modules with no platform or archi
    +tecture 
    independance.
    
    You may notice that the API to Archive::Ar is similar to Archive::Tar,
    + and
    this was done intentionally to keep similarity between the Archive::*
    modules
    
    
    =head2 Class Methods
    
    =over 4
    
    =item new()
    =item new($filename);
    =item new(*GLOB, $debug);
    
    Returns a new Archive::Ar object.  Without a filename or glob, it retu
    +rns an
    empty object.  If passed a filename as a scalar or in a GLOB, it will 
    +attempt
    to populate from either of those sources.  If it fails, you will recei
    +ve 
    undef, instead of an object reference. 
    
    This also can take a second optional debugging parameter.  This acts e
    +xactly
    as if DEBUG() is called on the object before it is returned.  If you h
    +ave a
    new() that keeps failing, this should help.
    
    =item read($filename)
    =item read(*GLOB);
    
    This reads a new file into the object, removing any ar archive already
    represented in the object.  Any calls to DEBUG() are not lost by readi
    +ng
    in a new file. Returns the number of bytes read, undef on failure.
    
    =item read_memory($data)
    
    This read information from the first parameter, and attempts to parse 
    +and treat
    it like an ar archive. Like read(), it will wipe out whatever you have
    + in the
    object and replace it with the contents of the new archive, even if it
    + fails.
    Returns the number of bytes read (processed) if successful, undef othe
    +rwise.
    
    =item list_files()
    
    This lists the files contained inside of the archive by filename, as a
    +n 
    array.
    
    =item add_files("filename1", "filename2")
    =item add_files(["filename1", "filename2"])
    
    Takes an array or an arrayref of filenames to add to the ar archive, i
    +n order.
    The filenames can be paths to files, in which case the path informatio
    +n is 
    stripped off.  Filenames longer than 16 characters are truncated when 
    +written
    to disk in the format, so keep that in mind when adding files.
    
    Due to the nature of the ar archive format, add_files() will store the
    + uid,
    gid, mode, size, and creation date of the file as returned by stat(); 
    
    add_files() returns the number of files sucessfully added, or undef on
    + failure.
    
    =item add_data("filename", $filedata)
    
    Takes an filename and a set of data to represent it. Unlike add_files,
    + add_data
    is a virtual add, and does not require data on disk to be present. The
    data is a hash that looks like:
    
    $filedata = {
            "data" => $data,
            "uid" => $uid, #defaults to zero
            "gid" => $gid, #defaults to zero
            "date" => $date,  #date in epoch seconds. Defaults to now.
            "mode" => $mode, #defaults to "100644";
    }
    
    You cannot add_data over another file however.  This returns the file 
    +length in 
    bytes if it is successful, undef otherwise.
    
    =item write()
    =item write("filename.ar")
    
    This method will return the data as an .ar archive, or will write to t
    +he 
    filename present if specified.  If given a filename, write() will retu
    +rn the 
    length of the file written, in bytes, or undef on failure.  If the fil
    +ename
    already exists, it will overwrite that file.
    
    =item get_content("filename")
    
    This returns a hash with the file content in it, including the data th
    +at the 
    file would naturally contain.  If the file does not exist or no filena
    +me is
    given, this returns undef. On success, a hash is returned with the fol
    +lowing
    keys:
    
    name - The file name
    date - The file date (in epoch seconds)
    uid  - The uid of the file
    gid  - The gid of the file
    mode - The mode permissions
    size - The size (in bytes) of the file
    data - The contained data
    
    =item DEBUG()
    
    This method turns on debugging.  Optionally this can be done by passin
    +g in a 
    value as the second parameter to new.  While verbosity is enabled, 
    Archive::Ar will toss a warn() if there is a suspicious condition or o
    +ther 
    problem while proceeding. This should help iron out any problems you h
    +ave
    while using the module.
    
    =head1 CHANGES
    
    =over 4
     
    =item Version 1.1
    
    Documentation cleanups
    
    =item Version 1.0
    
    This is the initial public release for CPAN, so everything is new.
    
    =head1 TODO
    
    A better unit test suite perhaps. I have a private one, but a public o
    +ne would be
    nice if there was good file faking module.
    
    Fix / investigate stuff in the BUGS section.
    
    =head1 BUGS
    
    To be honest, I'm not sure of a couple of things. The first is that I 
    +know 
    of ar archives made on old AIX systems (pre 4.3?) that have a differen
    +t header
    with a different magic string, etc.  This module perfectly (hopefully)
    + handles
    ar archives made with the modern ar command from the binutils distribt
    +uion. If
    anyone knows of anyway to produce these old-style AIX archives, or wou
    +ld like
    to produce a few for testing, I would be much grateful.
    
    There's no really good reason why this module /shouldn't/ run on Win32
    + 
    platforms, but admittedly, this might change when we have a file expor
    +ting 
    function that supports owner and permission writing.
    
    If you read in and write out a file, you get different md5sums, but it
    +'s still
    a valid archive. I'm still investigating this, and consider it a minor
    + bug.
    
    =head1 COPYRIGHT
    
    Archive::Ar is copyright 2003 Jay Bonci E<lt>jaybonci@cpan.orgE<gt>. 
    This program is free software; you can redistribute it and/or modify i
    +t under
    the same terms as Perl itself.
    
    =cut
    
JavaScript Dumper
1 direct reply — Read more / Contribute
by mugwumpjism
on Mar 07, 2003 at 01:25
    package JavaScript::Dumper;
    use strict;
    
    =head1 NAME
    
    JavaScript::Dumper - Dump a set of objects into JavaScript code
    
    =head1 SYNOPSIS
    
     use JavaScript::Dumper qw(JSDump);
    
     JavaScript::Dumper::config(object_mode => 1);
     print JSDump(@objects);
    
     # OO invocation
    
     use JavaScript::Dumper;
    
     my $jsd = JavaScript::Dumper->new(object_mode => 1);
     print $jsd->Dump(@objects);
    
     $jsd->set_variable_name("bert");
     print $jsd->Dump($bert);
    
    =head1 DESCRIPTION
    
    This module performs a task analogous to the standard C<Data::Dumper>
    module (see L<Data::Dumper>), but the idea is that the resultant data
    structure is to be reconstituted within an ECMAScript interpreter.
    
    =cut
    
    use Exporter;
    use Class::Tangram;
    use Set::Object;
    
    use vars qw(@ISA @EXPORT @EXPORT_OK $class_obj $fields);
    
    BEGIN {
        @ISA = qw(Class::Tangram Exporter);
    
        @EXPORT    = qw(&JSDump);
        @EXPORT_OK = qw(&Dumper &JSDump);
    
        $fields =
        {
         int => {
             # whether or not this dumper assumes you have JS classes
             # for all the objects available
             object_mode => undef,
    
             # whether or not this dumper will recurse deeply into
             # objects; this is off by default
             deep_recurse => undef,
    
             # internal - the count after while a variable name
             # becomes an extras name
             count => undef,
            },
         string => {
            # the variable name to use for output
            variable_name => {
                      init_default => "objects",
                     },
            extra_name => {
                       init_default => "extras",
                       },
               },
         set => {
             # Dump only these objects (used internally)
             dump_only => undef,
    
             # thingies that have already been dumped (Set::Objects
             # are not actually Set::Objects, they are Set::RVs so can
             # hold hashes, arrays etc. as long as they are
             # references.  They don't need to be blessed.)
             already_dumped => undef,
            },
    
         flat_hash => {
               # dump locations of blessed objects
               dump_positions => undef,
              },
    
         array => {
               dump_these => undef,
              },
    
         flat_array => {
                # the actual output lines
                output_lines => undef,
                # stitching calls
                output_stitching => undef,
               },
        };
    
        $class_obj = __PACKAGE__->new();
    
        no strict 'refs';
        *{__PACKAGE__."::$_"} = \&{"Class::Tangram::$_"}
        foreach qw(reftype blessed ish_int is_double is_string memid);
    }
    
    sub _obj {
        my $stackref = shift;
        if ( ref $stackref->[0] &&
         UNIVERSAL::isa($stackref->[0], __PACKAGE__ ) ) {
        return shift @$stackref;
        } elsif ( UNIVERSAL::isa($stackref->[0], __PACKAGE__ ) ) {
        no strict "refs";
        my $class = shift @$stackref;
        return (${$class."::class_obj"} || $class_obj);
        } else {
        return $class_obj;
        }
    }
    
    sub config {
        my $self = _obj(\@_);
        return $self->set(@_);
    }
    
    =head2 JSDumper(@objects)
    
    Dumps the passed objects as ECMAScript.
    
    =cut
        # this function the item number of the passed object/array
    sub _pos {
        my $self = shift;
        my $item = shift;
        my $key = memid($item);
        if ( !$self->already_dumped->includes($item) ) {
        push @{$self->dump_these}, $item;
        $self->dump_positions->{$key} =
            (@{$self->output_lines} + @{$self->dump_these});
        $self->already_dumped->insert($item);
        }
        #print "Pos of ".ref($item)." is ".$self->dump_positions->{$key}."
    +\n";
        return($self->dump_positions->{$key});
    }
    
    sub JSDump {
        return JSDumper(@_);
    }
    
    sub JSDumper {
        my $self = _obj(\@_);
    
        $self->already_dumped_clear();
    
        $self->set_dump_only(grep { ref($_) } @_)
        unless $self->deep_recurse;
    
        $self->set_count(scalar(@_));
    
        $self->set_dump_these([ @_ ]);
        $self->set_dump_positions({});
    
        $self->already_dumped->insert($_) foreach (grep { ref($_) } @_);
        my $n = 0;
        for my $item (@_) {
        if (ref $item) {
            ${ $self->dump_positions }{ memid($item) } = $n;
        }
        $n++;
        }
    
        # data is the list of objects, plus surplus objects & arrays
        $self->set_output_lines([]);
    
        # structure is a list of statements to link up what is necessary
        $self->set_output_stitching([]);
    
    
        while ( my $thingy = shift @{$self->dump_these} ) {
    
        if ( ref $thingy ) {
    
            if ( blessed($thingy) and !$thingy->isa("Set::Object") ) {
            if ( $self->object_mode ) {
               $self->js_object($thingy);
            } else {
               $self->js_structure($thingy);
            }
            } else {
            $self->js_structure($thingy);
            }
        } else {
            #print "Dumping `$thingy'\n";
            push @{ $self->output_lines}, $self->js_scalar($thingy);
        }
        }
    
        my $x = 0;
        return join ("",
             (map { $_ = "\$_ = $_;\n";
                s/\$_/$self->varname($x)/eg;
                ++$x; $_; }
              @{$self->output_lines}),
             (map { "$_;\n" }
              @{$self->output_stitching})
            );
    }
    
    sub varname {
        my $self = shift;
        my $x = shift;
    
        if ( $x >= $self->count ) {
        return $self->extra_name."[".($x-$self->count)."]";
        } else {
        return $self->variable_name."[".$x."]";
        }
    }
    
    #---------------------------------------------------------------------
    #  $self->js_structure($thingy)
    # Process the passed thingy as if it were an unblessed reference.
    #---------------------------------------------------------------------
    sub js_structure {
        my $self = shift;
        my $thingy = shift;
    
        my $is_set = 0;
    
        # must be an array or hash reference
        if ( reftype($thingy) eq "ARRAY"
         or (blessed($thingy) && $thingy->isa("Set::Object")
             && ($is_set = 1))) {
    
        # an array reference; go through the array and dump each
        # member, setting forward references where necessary.
        my @array;
        my $x = 0;
    
        for my $item ( $is_set ? $thingy->members() : @$thingy ) {
    
            if ( ref($item) ) {
    
            if ( $self->get_deep_recurse or
                 $self->dump_only->includes($item)
               ) {
                # it's an object - set a forward
                # reference
                my $n = $self->_pos($item);
                push @array, "'_o$n'";
                push @{ $self->output_stitching },
                ($self->varname(scalar(@{$self->output_lines}))
                 ."[$x] = ".$self->varname($n) );
            } else {
                # stringify it & hope for the best :-)
                push @array, "'$item'";
            }
    
            } else {
            push @array, $self->js_scalar($item);
            }
    
            $x++;
        }
        push @{ $self->output_lines },
            "[ ".join(", ", @array)." ]";
    
        } elsif ( reftype($thingy) eq "HASH" ) {
    
        # a hash; iterate over it, 
        my @array;
        my $x = 0;
    
        while ( my ($key, $item) = each %$thingy ) {
    
            if ( ref($item) ) {
    
            if ( $self->get_deep_recurse or
                 $self->dump_only->includes($item)
               ) {
    
                # it's an object - set a forward
                # reference
                my $n = $self->_pos($item);
                push @array, quoscape($key).":'_o$n'";
                push @{ $self->output_stitching },
                ($self->varname(scalar(@{ $self->output_lines }))
                 ."[".quoscape($key)."] = "
                 .$self->varname($n) );
            } else {
                # stringify it & hope for the best :-)
                push @array, (quoscape($key).":"
                      .quoscape($item));
            }
            } else {
            push @array, quoscape($key).":"
                .$self->js_scalar($item);
            }
    
            $x++;
        }
        push @{ $self->output_lines }, "{ ".join(", ", @array)." }";
    
        } elsif ( reftype($thingy) eq "SCALAR" ) {
        # hmm.  to be consistent let's do it this way
        my $item = $$thingy;
        if ( $self->get_deep_recurse or
             $self->dump_only->includes($item) ) {
            my $n = $self->_pos($item);
            push @{ $self->output_lines }, "'_o$n'";
            push @{ $self->output_stitching },
            ($self->varname(scalar(@{ $self->output_lines }))." = "
             .$self->varname($n));
        } else {
            push @{ $self->output_lines }, "'$item'";
        }
        } else {
        # eh?
        die("Don't know how to JS'ify `".reftype($thingy)."'");
        }
    
    }
    
    #---------------------------------------------------------------------
    #  $self->js_object($thingy)
    # Process the passed thingy as if it were a blessed reference.
    #---------------------------------------------------------------------
    sub js_object {
        my $self = shift;
        my $thingy = shift;
    
        # must be an array or hash reference
        if ( reftype($thingy) eq "ARRAY" ) {
    
        die "Sorry, blessed arrays are too wierd for this code";
    
        } elsif ( reftype($thingy) eq "HASH" ) {
    
        # a hash; iterate over it, 
        my @array;
        my $x = 0;
    
        while ( my ($key, $item) = each %$thingy ) {
    
            if ( ref($item) ) {
    
            if ( $self->get_deep_recurse or
                 $self->dump_only->includes($item)
               ) {
    
                # it's an object - set a forward
                # reference
                my $n = $self->_pos($item);
                #push @array, quoscape($key).":'_o$n'";
                push @{ $self->output_stitching },
                ($self->varname(scalar(@{ $self->output_lines }))
                 .".set_"
                 .$key."(".$self->varname($n).")");
            } else {
                # stringify it & hope for the best :-)
                push @array, (quoscape($key).":"
                      .quoscape($item));
            }
            } else {
            push @array, quoscape($key).":"
                .$self->js_scalar($item);
            }
    
            $x++;
        }
        push @{ $self->output_lines }, "new ".ref($thingy).'(); $_.set'
            ."({ ".join(", ", @array)." })";
    
        } elsif ( reftype($thingy) eq "SCALAR" ) {
    
        die "Sorry.  Blessed scalars are too wierd for this dumper";
    
        } else {
        # eh?
        die("Don't know how to JS'ify `".reftype($thingy)."'");
        }
    
    }
    
    sub js_scalar {
        my $self = _obj(\@_);
    
        my $thingy = shift;
        die "js_scalar passed reference" if ( ref($thingy) );
    
        if ( defined(ish_int($thingy)) ) {
        return $thingy."";
        } elsif ( is_double($thingy) ) {
            return sprintf("%.e", $thingy);
        } elsif ( is_string($thingy) ) {
        return quoscape($thingy);
        } elsif ( !defined($thingy) ) {
        return "null",
        } else {
        die("Don't know how to JS'ify scalar `$thingy'");
        }
    }
    
    sub quoscape {
        my $string = shift;
        $string =~ s/\\/\\\\/g;
        $string =~ s/"/\\"/g;
        $string =~ s/\n/\\n/g;
        $string =~ s/\r/\\r/g;
        # I assume JavaScript supports C-style escaping of
        # control characters...
        $string =~ s/[\0-\037\200-\377]/
        "\\".sprintf('%.3o',ord($&))/eg;
        return qq{"$string"};
    }
    
    1;
    
Yet Another :: N-Queens Solution
1 direct reply — Read more / Contribute
by Elgon
on Feb 10, 2003 at 15:13
    #!/usr/bin/perl -w
    
    use strict;
    
    # Nonspecific N-Queens Solution Generator by Elgon
    # Not sure whether truly crafty, but I'm happy with it!
    # Update: Added regexp to make the end result prettier.
    
    # Set up parameters
    my $n = 8;
    my $row_counter = 0;
    my @board;
    $board[0] = ('x'x$n);
    
    # Start the loop
    while ()
    {
        # Are there any free spaces in the current row?
    
        if ($board[$row_counter] =~ m/x/)
        {
            # If yes, then place a piece in the first available slot
            my @row = split(//, $board[$row_counter]);
            foreach $_(@row)
            {
                if ($_ eq 'x')
            {
                    $_ = 'q';
                    last;
                }    
            }
    
            $board[$row_counter] = join ('', @row);
            ++$row_counter;
    
            # Have we finished 'n' rows?
    
            if ($row_counter == $n)
            {
    
                # If so we have a valid solution. Save it to a file.
                open (DEST, ">> solutions.q") or die ('Couldn\'t open dest
    + file!');
                print DEST "\n\n";
                foreach $_(@board)
                {
                    my $temp_row = $_;
                    $temp_row =~ tr/q/X;
                    $temp_row =~ tr/yx/O/;
                    print DEST "$temp_row\n";
            }
                print DEST "\n";
                close DEST;
    
                # Now go back one row and make the old queen's spot invali
    +d
    
                --$row_counter;
                pop @board;
                --$row_counter;
                $board[$row_counter] =~ tr/q/y/;
        }
    
            #  Otherwise out which slots in the next row down will be unav
    +ailable
    
            else
            {
                my @current_row;
                for ($_ = 0; $_ < $n; ++$_)
                {
                    push @current_row, 'x';
            }
                my $row;
                for ($row = 0; $row < scalar(@board); ++$row)
                {
                    @row = split '', $board[$row];
                    my $square;
                    for ($square = 0; $square < scalar(@row); ++$square)
                    {
                        if ($row[$square] eq 'q')
                        {
                            $current_row[$square] = 'y';
                            if (($square - ($row_counter - $row)) >= 0)
                            {
                                $current_row[($square - ($row_counter - $r
    +ow))] = 'y';
                    }
                            if (($square + ($row_counter - $row)) <= ($n -
    + 1))
                            {
                                $current_row[($square + ($row_counter - $r
    +ow))] = 'y';
                    }
                }
                }
                }
    
                # Add the row to the board and go round again
                $board[$row_counter] = join ('', @current_row); 
            }
        }
    
        # If there are no available slots then we need to go back a row
    
        else
        {
    
            # But if we've used up the whole first row then all solutions 
    +are done
    
            if (!$row_counter && defined($row_counter))
            {
                print "\n\nCompleted!";
                exit;
            }
            else
    
            # Otherwise, go back a row...
    
            {
                pop @board;
                --$row_counter;
                $board[$row_counter] =~ tr/q/y/;
            }
        }
    }
    
Gaussian Elimination Algorithm
2 direct replies — Read more / Contribute
by grexman
on Jan 05, 2003 at 08:22
    #!/usr/bin/perl5.6.1 -w
    # Another Algorithm we learned in school as Perl code (-;
    # It is used for solving equations, and I put it here hoping 
    # for some hints what could be improved, because concerning 
    # elegance I do not like it and would be glad to have the 
    # possibilitie to learn from more experienced folks (-;
    # (especially readability is a problem for me)
    
    use strict;
    my (@MatrixA,@MatrixB,@MatrixX);
    # MatrixA will include the left-side of the equation,MatrixB the right
    +, MatrixX the solutions
    
    my $line_counter=0;
    # Input are equations of the Form: a*x1+b*x2+c*x3+..=A
    # Written as:a b c=A
    # Either in a file or just entered or line by line.
    # Input of the left side, has to be quadratic!
    while(<>)
    {  
        my @line_array;
        chomp;
        die "Wrong Character in Input, $_" unless /^[0123456789 -=]+$/;
        die "No B-Val found" unless s/=(-?\d+)$//;
        @line_array=(split / /);           
        $MatrixB[$line_counter]=$1;      
        $MatrixA[$line_counter]=\@line_array;
        $line_counter++;
    }
    #Check if all input lines have the same number of elements
    foreach (0..($line_counter-2))
    {
        my $line_length_1=@{$MatrixA[$_]};
        my $line_length_2=@{$MatrixA[$_+1]};
        die "ERROR:(Columns 1/Columns 2: $line_length_1/$line_length_2)\n"
    + unless ($line_length_1==$line_length_2);
    }
    
    my $input_lines=@MatrixB;
    my $input_columns=@{$MatrixA[0]};
    
    die "Matrix not quadratic"
        unless ($input_lines==$input_columns);
    
    my $format=$input_columns-1;
    
    sub Print_Matrix
    {
        print join(" ",@{$MatrixA[$_]})."=".$MatrixB[$_]."\n" foreach (0..
    +$input_columns-1); 
        print "\n";
    }
    
    
    &Print_Matrix;
    {
        # Creation of a compareable Matrix
        # To check if two lines are equivalent
        my (@Norm_MatrixA,@Norm_MatrixB);
        foreach my $current_line (0..$format)
        {  
        my $factor=$MatrixA[$current_line][0];
        foreach (0..($format))
        {
            $Norm_MatrixA[$current_line][$_]=$MatrixA[$current_line][$_]/$
    +factor;
            $Norm_MatrixB[$current_line]=$MatrixB[$current_line]/$factor;
        }      
        }
        # Compare the Lines of the Matrix:
        foreach (0..($format))
        {
        my $upper_line=$_;
        my $eq_counter=0;
        foreach(($upper_line+1)..($format))
        {
            my $lower_line=$_;
            foreach(0..($format))
            {
                $eq_counter++ if ($Norm_MatrixA[$upper_line][$_]==$Norm_Ma
    +trixA[$lower_line][$_]);
            }
            $eq_counter++ if ($Norm_MatrixB[$upper_line]==$Norm_MatrixB[$l
    +ower_line]);
            die "Two Lines of Matrix ident: $upper_line/$lower_line" if($e
    +q_counter>=$input_columns)
        }
        }
    }
    
    # Now here comes the Gauss Algorithm
    foreach my $SubMatrix (0..($input_lines-2))
    {
        foreach my $line (($SubMatrix+1)..($format))
        {    
        my $pivot=$MatrixA[$SubMatrix][$SubMatrix];
        my $first=$MatrixA[$line][$SubMatrix];
        foreach my $Spalte (0..($format))
        {
            $MatrixA[$line][$Spalte]=$MatrixA[$SubMatrix][$Spalte]+($Matri
    +xA[$line][$Spalte]*$pivot/$first*-1);
        }    
        $MatrixB[$line]=$MatrixB[$SubMatrix]+($MatrixB[$line]*$pivot/$firs
    +t*-1);
        } 
        &Print_Matrix;
    }
    
    # Get the solutions
    foreach my $solve_line (reverse (0..($format)))
    {
        my $leftsum=0;
        ($leftsum+=($MatrixA[$solve_line][$_]*$MatrixX[$_]))foreach ($solv
    +e_line+1..$format);  
        $MatrixX[$solve_line]=($MatrixB[$solve_line]-$leftsum)/($MatrixA[$
    +solve_line][$solve_line]);    
    }
    print "x_$_=$MatrixX[$_-1]\n"foreach(1..$format+1);
    
    
Wx::Carp - a replacement for Carp in Wx applications
1 direct reply — Read more / Contribute
by PodMaster
on Dec 24, 2002 at 19:05
    ## get it while it's hot (cause it's not part of wxPerl core yet)
    
    ######################################################################
    +#######
    ## Name:        Carp.pm
    ## Purpose:     Wx::Carp class (a replacement for Carp in Wx applicati
    +ons)
    ## Author:      D.H. aka PodMaster
    ## Modified by:
    ## Created:      12/24/2002
    ## RCS-ID:      
    ## Copyright:   (c) 2002 D.H.
    ## Licence:     This program is free software; you can redistribute it
    + and/or
    ##              modify it under the same terms as Perl itself
    ######################################################################
    +#######
    
    =head1 NAME
    
    Wx::Carp - a replacement for Carp in Wx applications
    
    =head1 SYNOPSIS
    
    Just like L<Carp>, so go see the L<Carp> pod (cause it's based on L<Ca
    +rp>).
    
        # short example
        use Wx::Carp;
        ...
        carp "i'm warn-ing";
        croak "i'm die-ing";
    
    =head1 SEE ALSO
    
    L<Carp> L<Carp> L<Carp> L<Carp> L<Carp>
    
    =head1 COPYRIGHT
    
    (c) 2002 D.H. aka PodMaster (a proud CPAN author)
    
    =cut
    
    package Wx::Carp;
    
    BEGIN {
        require Carp;
        require Wx;
    }
    
    use Exporter;
    @ISA         = qw( Exporter );
    @EXPORT      = qw( confess croak carp );
    @EXPORT_OK   = qw( cluck verbose );
    @EXPORT_FAIL = qw( verbose );              # hook to enable verbose mo
    +de
    
    sub export_fail { Carp::export_fail( @_) } # make verbose work for me
    sub croak   { Wx::LogFatalError( Carp::shortmess(@_) ) }
    sub confess { Wx::LogFatalError( Carp::longmess(@_) ) }
    sub carp    { Wx::LogWarning( Carp::shortmess(@_) ) }
    sub cluck   { Wx::LogWarning( Carp::longmess(@_) ) }
    
    1;
    
Creating Neat CVS snapshots...
No replies — Read more | Post response
by cyberconte
on Dec 20, 2002 at 09:48
    Just thought i would share this... i created it after
    finding not finding anything with this functionality
    (a while ago).  It was made for my personal needs 
    initially, and was doctored up a few weeks later to
    be somewhat customizable.  Its about a year old.
    
    I have a cronjob that runs it every day:
    0 1 * * * /home/conteb/cvs/snapshot.pl phynd /var/www/snapshots /var/c
    +vs >> /var/www/snapshots/snapshots.log 2>&1
    
    Sample can be found at http://www.phynd.net/snapshots/
    
    #!/usr/bin/perl
    #
    # Create nightly cvs snapshots of project in a 
    # repository, only saving the snapshot if the module 
    # has changed.
    # 
    # TODO: Error checking is by no means complete.
    #
    use Date::Manip;
    
    use strict;
    use warnings;
    
    sub printHelp; # print basic help screen
    
    my $tempdir = '/tmp/';
    my $maxdayspast = 90; # will only check 90 days in the past before rec
    +ording.
    
    # Can take 1 - 3 args - project name and dir to put resulting snapshot
    my $project = shift(@ARGV) or printHelp;
    my $dest = shift(@ARGV) or printHelp;
    my $server = shift(@ARGV) or printHelp;
    
    
    # test $tempdir, $dest for access and writabilty
    die "Error: No access to /tmp or /tmp not a dir\n"
        unless (-w $tempdir && -d $tempdir);
    die "Error: No access to $dest, $dest not a dir, or $dest doen't exist
    +\n"
        unless (-d $dest && -w $dest);
    
    
    # First checkout the needed cvs directory
    chdir $tempdir;
    if (defined $server) {
        (`cvs -d $server co -P $project 2>&1`=~/cannot find module/) and 
        die "Error: Invalid project specified - could not find module\n";
    }
    
    # get todays date and adjust acordingly...
    my $date=$1 if &ParseDate('today')=~/(\d{8})/;
    
    # create tarball
    `tar czf $dest/$project-$date.tar.gz $project`;
    
    # Now, find the last tarball
    my $prev=1;
    my $filename;
    do {
        &DateCalc($date, "-".$prev." days")=~/(\d{8})/;
        $filename=$dest.'/'.$project."-".$1.".tar.gz";
        $prev++;
    } while ((!(-e $filename))&&($prev < $maxdayspast));
    
    # for some reason, compressed tarballs of identical trees checked out
    # at different times create slightly different sized tarballs (on my 
    # machine, anyway, using reiserfs).  I'm not about to step out of my 
    # league and try to explain it - but it means we have to untar the pac
    +kage
    # and run a diff on the two trees to see if there is a difference.
    if ($prev == $maxdayspast) {
        print "Did not find any snapshots within $maxdayspast days, record
    +ing new..."; }
    else {
        `mv $project $project.new`;
        `tar xzvf $filename `;
        if (`diff -Naur $project $project.new`) {
        print "Changes detected, recording snapshot...";
        }
        else {
        `rm $dest/$project-$date.tar.gz`; # dont save if nothing changed
        }
        `rm -r $project.new`;
    }
    
    # remove project directories
    `rm -r $project`;
    print "Done ($date)\n";
    exit;
    
    sub printHelp {
        print "Usage: snapshot.pl project destination_dir server\n";
        print "  project           name of project to check out of cvs\n";
        print "  destination_dir   where to put the snapshot\n";
        print "  server            server to connect to.  used as cvs -d s
    +erver...\n";
        exit;
    }
    
modify @INC
2 direct replies — Read more / Contribute
by pfm
on Dec 04, 2002 at 04:29
    # I didn't know about the node 104334
    # when this came to my mind
    # I think it is interesting
    
    $dot = pop @INC;         # a dot marks the end of @INC
    push @INC, $your_path;   # so you add you path
    push @INC, $dot;         # and put it back
    
    use AnythingFromThePath; # and use your stuff
    
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (9)
As of 2015-07-07 06:44 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (87 votes), past polls