Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
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 studying the Monastery: (10)
As of 2014-12-18 21:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (66 votes), past polls